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 magic version _ _ _ _ _ _) <- Get Header
getHeader
      unless (magic == "TZif") (fail $ "unknown magic: " ++ magic)
      (getInt, header'@(Header _ _ _ _ _ _ typeCount _)) <- getCorrectHeader header
      unless
        (typeCount >= 1)
        (fail $ "format issue: ttypecnt must be at least 1 but is " ++ show typeCount)
      (transitions, indexes, tInfos) <- getPayload getInt header'
      tzString <- getTZString version
      finished <- isEmpty
      unless finished $ fail "unprocessed data still in olson file"
      let (utcM, calDateM) = buildTransitionMaps (zip transitions indexes) tInfos tzString
      return (utcM, 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 magic _ _ _ _ _ _ _) <- Get Header
getHeader
      return $ magic == "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
  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
  version <- getCh
  skip reservedSectionSize
  [ttisgmtcnt, ttisstdcnt, leapcnt, transcnt, ttypecnt, abbrlen] <- replicateM 6 getUInt32
  return $ Header magic version ttisgmtcnt ttisstdcnt leapcnt transcnt ttypecnt 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
  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
  indexes <- replicateM transCount getInt8
  types <- replicateM typeCount $ (,,) <$> getInt32 <*> getBool <*> getInt8
  abbrs <- (toString . B.unpack) <$> getByteString abbrLen
  skip $ leapCount + isStdCount + isGmtCount
  let tInfos = String -> [(Int, Bool, Int)] -> [TransitionInfo]
mapTransitionInfos String
abbrs [(Int, Bool, Int)]
types
  return (transitions, indexes, 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. HasCallStack => String -> Get a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
      correctHeader <- Get Header
getHeader
      return (getInt64, 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. HasCallStack => String -> Get a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
      nl <- Get Char
getCh
      unless (nl == '\n') (fail $ "POSIX TZ string preceded by non-newline:" ++ show nl)
      posixTZ <- getWhileM (/= '\n')
      return . Just $ posixTZ
    getWhileM :: (Char -> Bool) -> Get String
getWhileM Char -> Bool
p = do
      ch <- Get Char
getCh
      if p ch then do
        rest <- getWhileM p
        return $ ch : rest
      else 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 (Int32
yr, Word8
_, Word8
_) = Instant -> (Int32, Word8, Word8)
instantToYearMonthDay Instant
trans in Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
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)