module Data.HodaTime.TimeZone.Olson
(
   getTransitions
  ,isOlsonFile
  ,ParseException(..)
)
where

import Data.HodaTime.TimeZone.Internal
import Data.HodaTime.TimeZone.ParseTZ (parsePosixString)

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Binary.Get (Get, getWord8, getWord32be, getInt32be, getInt64be, getByteString, runGetOrFail, skip, isEmpty)
import Data.Word (Word8)
import Control.Monad (unless, replicateM)
import Data.List (foldl')
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow, throwM)
import Data.Typeable (Typeable)
import Data.HodaTime.Instant.Internal (Instant(..), fromSecondsSinceUnixEpoch, minus, bigBang)
import Data.HodaTime.Duration.Internal (fromNanoseconds)
import Data.HodaTime.Offset.Internal (Offset(..), adjustInstant)
import Data.HodaTime.Calendar.Gregorian.Internal (instantToYearMonthDay, yearMonthDayToDays)

data ParseException = ParseException String Int
  deriving (Typeable, Int -> ParseException -> ShowS
[ParseException] -> ShowS
ParseException -> String
(Int -> ParseException -> ShowS)
-> (ParseException -> String)
-> ([ParseException] -> ShowS)
-> Show ParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseException -> ShowS
showsPrec :: Int -> ParseException -> ShowS
$cshow :: ParseException -> String
show :: ParseException -> String
$cshowList :: [ParseException] -> ShowS
showList :: [ParseException] -> ShowS
Show)

instance Exception ParseException

data Header = Header String Char Int Int Int Int Int Int

reservedSectionSize :: Int
reservedSectionSize :: Int
reservedSectionSize = Int
15

getTransitions :: MonadThrow m => L.ByteString -> m (UtcTransitionsMap, CalDateTransitionsMap)
getTransitions :: forall (m :: * -> *).
MonadThrow m =>
ByteString -> m (UtcTransitionsMap, CalDateTransitionsMap)
getTransitions ByteString
bs = case Get (UtcTransitionsMap, CalDateTransitionsMap)
-> ByteString
-> Either
     (ByteString, Int64, String)
     (ByteString, Int64, (UtcTransitionsMap, CalDateTransitionsMap))
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get (UtcTransitionsMap, CalDateTransitionsMap)
getTransitions' ByteString
bs of
  Left (ByteString
_, Int64
consumed, String
msg) -> ParseException -> m (UtcTransitionsMap, CalDateTransitionsMap)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (ParseException -> m (UtcTransitionsMap, CalDateTransitionsMap))
-> ParseException -> m (UtcTransitionsMap, CalDateTransitionsMap)
forall a b. (a -> b) -> a -> b
$ String -> Int -> ParseException
ParseException String
msg (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
consumed)
  Right (ByteString
_, Int64
_, (UtcTransitionsMap, CalDateTransitionsMap)
xs) -> (UtcTransitionsMap, CalDateTransitionsMap)
-> m (UtcTransitionsMap, CalDateTransitionsMap)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (UtcTransitionsMap, CalDateTransitionsMap)
xs
  where
    getTransitions' :: Get (UtcTransitionsMap, CalDateTransitionsMap)
getTransitions' = do
      header :: Header
header@(Header String
magic Char
version Int
_ Int
_ Int
_ Int
_ Int
_ Int
_) <- Get Header
getHeader
      Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
magic String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TZif") (String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"unknown magic: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
magic)
      (Get Int
getInt, header' :: Header
header'@(Header String
_ Char
_ Int
_ Int
_ Int
_ Int
_ Int
typeCount Int
_)) <- Header -> Get (Get Int, Header)
getCorrectHeader Header
header
      Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
        (Int
typeCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1)
        (String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"format issue: ttypecnt must be at least 1 but is " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
typeCount)
      ([Instant]
transitions, [Int]
indexes, [TransitionInfo]
tInfos) <- Get Int -> Header -> Get ([Instant], [Int], [TransitionInfo])
getPayload Get Int
getInt Header
header'
      Maybe String
tzString <- Char -> Get (Maybe String)
getTZString Char
version
      Bool
finished <- Get Bool
isEmpty
      Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
finished (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unprocessed data still in olson file"
      let (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM) = [(Instant, Int)]
-> [TransitionInfo]
-> Maybe String
-> (UtcTransitionsMap, CalDateTransitionsMap)
buildTransitionMaps ([Instant] -> [Int] -> [(Instant, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Instant]
transitions [Int]
indexes) [TransitionInfo]
tInfos Maybe String
tzString
      (UtcTransitionsMap, CalDateTransitionsMap)
-> Get (UtcTransitionsMap, CalDateTransitionsMap)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM)

isOlsonFile :: L.ByteString -> Bool
isOlsonFile :: ByteString -> Bool
isOlsonFile ByteString
bs = case Get Bool
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, Bool)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
runGetOrFail Get Bool
getMagic ByteString
bs of
  Left (ByteString, Int64, String)
_ -> Bool
False         -- If we can't load it for any reason, we wouldn't be able to use it as a time zone
  Right (ByteString
_, Int64
_, Bool
x) -> Bool
x
  where
    getMagic :: Get Bool
getMagic = do
      (Header String
magic Char
_ Int
_ Int
_ Int
_ Int
_ Int
_ Int
_) <- Get Header
getHeader
      Bool -> Get Bool
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Get Bool) -> Bool -> Get Bool
forall a b. (a -> b) -> a -> b
$ String
magic String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TZif"

-- Get combinators

getCh :: Get Char
getCh :: Get Char
getCh = (Word8 -> Char) -> Get Word8 -> Get Char
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
toChar Get Word8
getWord8
  where
    toChar :: Word8 -> Char
toChar = 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

getBool :: Get Bool
getBool :: Get Bool
getBool = (Word8 -> Bool) -> Get Word8 -> Get Bool
forall a b. (a -> b) -> Get a -> Get b
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

getInt8 :: Get Int
getInt8 :: Get Int
getInt8 = (Word8 -> Int) -> Get Word8 -> Get Int
forall a b. (a -> b) -> Get a -> Get b
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

getUInt32 :: Get Int
getUInt32 :: Get Int
getUInt32 = (Word32 -> Int) -> Get Word32 -> Get Int
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word32
getWord32be

getInt32 :: Get Int
getInt32 :: Get Int
getInt32 = (Int32 -> Int) -> Get Int32 -> Get Int
forall a b. (a -> b) -> Get a -> Get b
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
getInt32be

getInt64 :: Get Int
getInt64 :: Get Int
getInt64 = (Int64 -> Int) -> Get Int64 -> Get Int
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int64
getInt64be

getHeader :: Get Header
getHeader :: Get Header
getHeader = do
  String
magic <- ([Word8] -> String
toString ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack) (ByteString -> String) -> Get ByteString -> Get String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
4
  Char
version <- Get Char
getCh
  Int -> Get ()
skip Int
reservedSectionSize
  [Int
ttisgmtcnt, Int
ttisstdcnt, Int
leapcnt, Int
transcnt, Int
ttypecnt, Int
abbrlen] <- Int -> Get Int -> Get [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
6 Get Int
getUInt32
  Header -> Get Header
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> Get Header) -> Header -> Get Header
forall a b. (a -> b) -> a -> b
$ String -> Char -> Int -> Int -> Int -> Int -> Int -> Int -> Header
Header String
magic Char
version Int
ttisgmtcnt Int
ttisstdcnt Int
leapcnt Int
transcnt Int
ttypecnt Int
abbrlen

getPayload :: Get Int -> Header -> Get ([Instant], [Int], [TransitionInfo])
getPayload :: Get Int -> Header -> Get ([Instant], [Int], [TransitionInfo])
getPayload Get Int
getInt (Header String
_ Char
_ Int
isGmtCount Int
isStdCount Int
leapCount Int
transCount Int
typeCount Int
abbrLen) = do
  [Instant]
transitions <- Int -> Get Instant -> Get [Instant]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
transCount (Get Instant -> Get [Instant]) -> Get Instant -> Get [Instant]
forall a b. (a -> b) -> a -> b
$ Int -> Instant
fromSecondsSinceUnixEpoch (Int -> Instant) -> Get Int -> Get Instant
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt
  [Int]
indexes <- Int -> Get Int -> Get [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
transCount Get Int
getInt8
  [(Int, Bool, Int)]
types <- Int -> Get (Int, Bool, Int) -> Get [(Int, Bool, Int)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
typeCount (Get (Int, Bool, Int) -> Get [(Int, Bool, Int)])
-> Get (Int, Bool, Int) -> Get [(Int, Bool, Int)]
forall a b. (a -> b) -> a -> b
$ (,,) (Int -> Bool -> Int -> (Int, Bool, Int))
-> Get Int -> Get (Bool -> Int -> (Int, Bool, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
getInt32 Get (Bool -> Int -> (Int, Bool, Int))
-> Get Bool -> Get (Int -> (Int, Bool, Int))
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Bool
getBool Get (Int -> (Int, Bool, Int)) -> Get Int -> Get (Int, Bool, Int)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Int
getInt8
  String
abbrs <- ([Word8] -> String
toString ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack) (ByteString -> String) -> Get ByteString -> Get String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString Int
abbrLen
  Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Int
leapCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
isStdCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
isGmtCount
  let tInfos :: [TransitionInfo]
tInfos = String -> [(Int, Bool, Int)] -> [TransitionInfo]
mapTransitionInfos String
abbrs [(Int, Bool, Int)]
types
  ([Instant], [Int], [TransitionInfo])
-> Get ([Instant], [Int], [TransitionInfo])
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Instant]
transitions, [Int]
indexes, [TransitionInfo]
tInfos)
getCorrectHeader :: Header -> Get (Get Int, Header)
getCorrectHeader :: Header -> Get (Get Int, Header)
getCorrectHeader header :: Header
header@(Header String
_ Char
version Int
isGmtCount Int
isStdCount Int
leapCount Int
transCount Int
typeCount Int
abbrLen)
  | Char
version Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL'                 = (Get Int, Header) -> Get (Get Int, Header)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Get Int
getInt32, Header
header)
  | Char
version Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1' Bool -> Bool -> Bool
|| Char
version Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'2'  = Get (Get Int, Header)
skipOldDataAndGetHeader
  | Bool
otherwise                         = String -> Get (Get Int, Header)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Get Int, Header))
-> String -> Get (Get Int, Header)
forall a b. (a -> b) -> a -> b
$ String
"unknown olson version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
version
  where
    skipOldDataAndGetHeader :: Get (Get Int, Header)
skipOldDataAndGetHeader = do
      Int -> Get ()
skip (Int -> Get ()) -> Int -> Get ()
forall a b. (a -> b) -> a -> b
$ Int
transCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
transCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
typeCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
typeCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
typeCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
abbrLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leapCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
isStdCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
isGmtCount
      Header
correctHeader <- Get Header
getHeader
      (Get Int, Header) -> Get (Get Int, Header)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Get Int
getInt64, Header
correctHeader)

getTZString :: Char -> Get (Maybe String)
getTZString :: Char -> Get (Maybe String)
getTZString Char
version
  | Char
version Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\NUL'                 = Maybe String -> Get (Maybe String)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
  | Char
version Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1' Bool -> Bool -> Bool
|| Char
version Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'2'  = Get (Maybe String)
getTZString'
  | Bool
otherwise                         = String -> Get (Maybe String)
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get (Maybe String)) -> String -> Get (Maybe String)
forall a b. (a -> b) -> a -> b
$ String
"impossible: unknown version in getTZString"
  where
    getTZString' :: Get (Maybe String)
getTZString' = do
      Char
nl <- Get Char
getCh
      Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Char
nl Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n') (String -> Get ()
forall a. String -> Get a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"POSIX TZ string preceded by non-newline:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
nl)
      String
posixTZ <- (Char -> Bool) -> Get String
getWhileM (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
      Maybe String -> Get (Maybe String)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Get (Maybe String))
-> (String -> Maybe String) -> String -> Get (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Get (Maybe String)) -> String -> Get (Maybe String)
forall a b. (a -> b) -> a -> b
$ String
posixTZ
    getWhileM :: (Char -> Bool) -> Get String
getWhileM Char -> Bool
p = do
      Char
ch <- Get Char
getCh
      if Char -> Bool
p Char
ch then do
        String
rest <- (Char -> Bool) -> Get String
getWhileM Char -> Bool
p
        String -> Get String
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Get String) -> String -> Get String
forall a b. (a -> b) -> a -> b
$ Char
ch Char -> ShowS
forall a. a -> [a] -> [a]
: String
rest
      else String -> Get String
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- helper fucntions

mapTransitionInfos :: String -> [(Int, Bool, Int)] -> [TransitionInfo]
mapTransitionInfos :: String -> [(Int, Bool, Int)] -> [TransitionInfo]
mapTransitionInfos String
abbrs = ((Int, Bool, Int) -> TransitionInfo)
-> [(Int, Bool, Int)] -> [TransitionInfo]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, Bool, Int) -> TransitionInfo
toTI
  where
    toTI :: (Int, Bool, Int) -> TransitionInfo
toTI (Int
gmt, Bool
isdst, Int
offset) = Offset -> Bool -> String -> TransitionInfo
TransitionInfo (Int -> Offset
Offset Int
gmt) Bool
isdst (String -> TransitionInfo) -> String -> TransitionInfo
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
getAbbr Int
offset String
abbrs
    getAbbr :: Int -> ShowS
getAbbr Int
offset = (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
offset

buildTransitionMaps :: [(Instant, Int)] -> [TransitionInfo] -> Maybe String -> (UtcTransitionsMap, CalDateTransitionsMap)
buildTransitionMaps :: [(Instant, Int)]
-> [TransitionInfo]
-> Maybe String
-> (UtcTransitionsMap, CalDateTransitionsMap)
buildTransitionMaps [(Instant, Int)]
transAndIndexes [TransitionInfo]
tInfos Maybe String
tzString = (UtcTransitionsMap
utcMap', CalDateTransitionsMap
calDateMap')
  where
    (UtcTransitionsMap
utcMap', CalDateTransitionsMap
calDateMap') = Maybe (Either TransitionInfo TransitionExpressionInfo)
-> IntervalEntry Instant
-> TransitionInfo
-> UtcTransitionsMap
-> CalDateTransitionsMap
-> (UtcTransitionsMap, CalDateTransitionsMap)
addLastMapEntries Maybe (Either TransitionInfo TransitionExpressionInfo)
tzString' IntervalEntry Instant
lastEntry TransitionInfo
lastTI UtcTransitionsMap
utcMap CalDateTransitionsMap
calDateMap
    tzString' :: Maybe (Either TransitionInfo TransitionExpressionInfo)
tzString' = (String -> Either TransitionInfo TransitionExpressionInfo)
-> Maybe String
-> Maybe (Either TransitionInfo TransitionExpressionInfo)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Either TransitionInfo TransitionExpressionInfo
parsePosixString Maybe String
tzString
    defaultTI :: TransitionInfo
defaultTI = [TransitionInfo] -> TransitionInfo
findDefaultTransInfo ([TransitionInfo] -> TransitionInfo)
-> [TransitionInfo] -> TransitionInfo
forall a b. (a -> b) -> a -> b
$ [TransitionInfo]
tInfos
    initialUtcTransitions :: UtcTransitionsMap
initialUtcTransitions = Instant -> TransitionInfo -> UtcTransitionsMap -> UtcTransitionsMap
addUtcTransition Instant
bigBang TransitionInfo
defaultTI UtcTransitionsMap
emptyUtcTransitions
    (UtcTransitionsMap
utcMap, CalDateTransitionsMap
calDateMap, IntervalEntry Instant
lastEntry, TransitionInfo
lastTI) = ((UtcTransitionsMap, CalDateTransitionsMap, IntervalEntry Instant,
  TransitionInfo)
 -> (Instant, Int)
 -> (UtcTransitionsMap, CalDateTransitionsMap,
     IntervalEntry Instant, TransitionInfo))
-> (UtcTransitionsMap, CalDateTransitionsMap,
    IntervalEntry Instant, TransitionInfo)
-> [(Instant, Int)]
-> (UtcTransitionsMap, CalDateTransitionsMap,
    IntervalEntry Instant, TransitionInfo)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (UtcTransitionsMap, CalDateTransitionsMap, IntervalEntry Instant,
 TransitionInfo)
-> (Instant, Int)
-> (UtcTransitionsMap, CalDateTransitionsMap,
    IntervalEntry Instant, TransitionInfo)
go (UtcTransitionsMap
initialUtcTransitions, CalDateTransitionsMap
emptyCalDateTransitions, IntervalEntry Instant
forall a. IntervalEntry a
Smallest, TransitionInfo
defaultTI) [(Instant, Int)]
transAndIndexes
    go :: (UtcTransitionsMap, CalDateTransitionsMap, IntervalEntry Instant,
 TransitionInfo)
-> (Instant, Int)
-> (UtcTransitionsMap, CalDateTransitionsMap,
    IntervalEntry Instant, TransitionInfo)
go (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM, IntervalEntry Instant
prevEntry, TransitionInfo
prevTI) (Instant
tran, Int
idx) = (UtcTransitionsMap
utcM', CalDateTransitionsMap
calDateM', Instant -> IntervalEntry Instant
forall a. a -> IntervalEntry a
Entry Instant
localTran, TransitionInfo
tInfo)
      where
        utcM' :: UtcTransitionsMap
utcM' = Instant -> TransitionInfo -> UtcTransitionsMap -> UtcTransitionsMap
addUtcTransition Instant
tran TransitionInfo
tInfo UtcTransitionsMap
utcM
        calDateM' :: CalDateTransitionsMap
calDateM' = IntervalEntry Instant
-> IntervalEntry Instant
-> TransitionInfo
-> CalDateTransitionsMap
-> CalDateTransitionsMap
addCalDateTransition IntervalEntry Instant
prevEntry IntervalEntry Instant
before TransitionInfo
prevTI CalDateTransitionsMap
calDateM
        localTran :: Instant
localTran = Offset -> Instant -> Instant
adjustInstant (TransitionInfo -> Offset
tiUtcOffset TransitionInfo
tInfo) (Instant -> Instant) -> Instant -> Instant
forall a b. (a -> b) -> a -> b
$ Instant
tran
        before :: IntervalEntry Instant
before = Instant -> IntervalEntry Instant
forall a. a -> IntervalEntry a
Entry (Instant -> IntervalEntry Instant)
-> (Instant -> Instant) -> Instant -> IntervalEntry Instant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Instant -> Duration -> Instant) -> Duration -> Instant -> Instant
forall a b c. (a -> b -> c) -> b -> a -> c
flip Instant -> Duration -> Instant
minus (Int -> Duration
fromNanoseconds Int
1) (Instant -> Instant) -> (Instant -> Instant) -> Instant -> Instant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Offset -> Instant -> Instant
adjustInstant (TransitionInfo -> Offset
tiUtcOffset TransitionInfo
prevTI) (Instant -> IntervalEntry Instant)
-> Instant -> IntervalEntry Instant
forall a b. (a -> b) -> a -> b
$ Instant
tran
        tInfo :: TransitionInfo
tInfo = [TransitionInfo]
tInfos [TransitionInfo] -> Int -> TransitionInfo
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx

addLastMapEntries :: Maybe (Either TransitionInfo TransitionExpressionInfo) -> IntervalEntry Instant -> TransitionInfo ->
                      UtcTransitionsMap -> CalDateTransitionsMap -> (UtcTransitionsMap, CalDateTransitionsMap)
addLastMapEntries :: Maybe (Either TransitionInfo TransitionExpressionInfo)
-> IntervalEntry Instant
-> TransitionInfo
-> UtcTransitionsMap
-> CalDateTransitionsMap
-> (UtcTransitionsMap, CalDateTransitionsMap)
addLastMapEntries Maybe (Either TransitionInfo TransitionExpressionInfo)
Nothing IntervalEntry Instant
start TransitionInfo
ti UtcTransitionsMap
utcMap CalDateTransitionsMap
calDateMap = (UtcTransitionsMap
utcMap, IntervalEntry Instant
-> IntervalEntry Instant
-> TransitionInfo
-> CalDateTransitionsMap
-> CalDateTransitionsMap
addCalDateTransition IntervalEntry Instant
start IntervalEntry Instant
forall a. IntervalEntry a
Largest TransitionInfo
ti CalDateTransitionsMap
calDateMap)
-- NOTE: If the tzString does not have a time zone specification then the way we process the rest of the file should be correct (TODO: check offset) so we can ignore it
addLastMapEntries (Just (Left TransitionInfo
_)) IntervalEntry Instant
start TransitionInfo
ti UtcTransitionsMap
utcMap CalDateTransitionsMap
calDateMap = (UtcTransitionsMap
utcMap, IntervalEntry Instant
-> IntervalEntry Instant
-> TransitionInfo
-> CalDateTransitionsMap
-> CalDateTransitionsMap
addCalDateTransition IntervalEntry Instant
start IntervalEntry Instant
forall a. IntervalEntry a
Largest TransitionInfo
ti CalDateTransitionsMap
calDateMap)
addLastMapEntries (Just (Right texpr :: TransitionExpressionInfo
texpr@(TransitionExpressionInfo TransitionExpression
_ TransitionExpression
_ TransitionInfo
stdTI TransitionInfo
_))) IntervalEntry Instant
prevTran TransitionInfo
prevTI UtcTransitionsMap
utcMap CalDateTransitionsMap
calDateMap = (UtcTransitionsMap
utcMap', CalDateTransitionsMap
calDateMap'')
  where
    utcMap' :: UtcTransitionsMap
utcMap' = Instant
-> TransitionExpressionInfo
-> UtcTransitionsMap
-> UtcTransitionsMap
addUtcTransitionExpression Instant
exprStart TransitionExpressionInfo
texpr UtcTransitionsMap
utcMap
    calDateMap' :: CalDateTransitionsMap
calDateMap' = IntervalEntry Instant
-> IntervalEntry Instant
-> TransitionInfo
-> CalDateTransitionsMap
-> CalDateTransitionsMap
addCalDateTransition IntervalEntry Instant
prevTran IntervalEntry Instant
before TransitionInfo
prevTI CalDateTransitionsMap
calDateMap
    calDateMap'' :: CalDateTransitionsMap
calDateMap'' = IntervalEntry Instant
-> IntervalEntry Instant
-> TransitionExpressionInfo
-> CalDateTransitionsMap
-> CalDateTransitionsMap
addCalDateTransitionExpression (Instant -> IntervalEntry Instant
forall a. a -> IntervalEntry a
Entry Instant
exprStart) IntervalEntry Instant
forall a. IntervalEntry a
Largest TransitionExpressionInfo
texpr CalDateTransitionsMap
calDateMap'
    before :: IntervalEntry Instant
before = Instant -> IntervalEntry Instant
forall a. a -> IntervalEntry a
Entry (Instant -> IntervalEntry Instant)
-> (Instant -> Instant) -> Instant -> IntervalEntry Instant
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Instant -> Duration -> Instant) -> Duration -> Instant -> Instant
forall a b c. (a -> b -> c) -> b -> a -> c
flip Instant -> Duration -> Instant
minus (Int -> Duration
fromNanoseconds Int
1) (Instant -> IntervalEntry Instant)
-> Instant -> IntervalEntry Instant
forall a b. (a -> b) -> a -> b
$ Instant
exprStart
    exprStart :: Instant
exprStart = Offset -> Instant -> Instant
adjustInstant (TransitionInfo -> Offset
tiUtcOffset TransitionInfo
stdTI) (Instant -> Instant) -> Instant -> Instant
forall a b. (a -> b) -> a -> b
$ Int32 -> Word32 -> Word32 -> Instant
Instant Int32
yearStart Word32
0 Word32
0  -- time changes are usually once per year
    yearStart :: Int32
yearStart = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Int -> Month Gregorian -> Int -> Int
yearMonthDayToDays (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Month Gregorian
forall a. Enum a => Int -> a
toEnum Int
0) Int
1
    y :: Int
y = case IntervalEntry Instant
prevTran of
      (Entry Instant
trans) -> let (Word32
yr, Word8
_, Word8
_) = Instant -> (Word32, Word8, Word8)
instantToYearMonthDay Instant
trans in Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
yr
      IntervalEntry Instant
_             -> String -> Int
forall a. HasCallStack => String -> a
error String
"impossible: got non Entry for last valid transition"

findDefaultTransInfo :: [TransitionInfo] -> TransitionInfo
findDefaultTransInfo :: [TransitionInfo] -> TransitionInfo
findDefaultTransInfo [TransitionInfo]
tis = [TransitionInfo] -> TransitionInfo
go ([TransitionInfo] -> TransitionInfo)
-> ([TransitionInfo] -> [TransitionInfo])
-> [TransitionInfo]
-> TransitionInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransitionInfo -> Bool) -> [TransitionInfo] -> [TransitionInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False) (Bool -> Bool)
-> (TransitionInfo -> Bool) -> TransitionInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransitionInfo -> Bool
tiIsDst) ([TransitionInfo] -> TransitionInfo)
-> [TransitionInfo] -> TransitionInfo
forall a b. (a -> b) -> a -> b
$ [TransitionInfo]
tis
  where
    go :: [TransitionInfo] -> TransitionInfo
go [] = [TransitionInfo] -> TransitionInfo
forall a. HasCallStack => [a] -> a
head [TransitionInfo]
tis
    go (TransitionInfo
ti:[TransitionInfo]
_) = TransitionInfo
ti

toString :: [Word8] -> String
toString :: [Word8] -> String
toString = (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)