{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Time.LocalTime.TimeZone.Olson.Types
-- Copyright   :  Yitzchak Gale 2019
--
-- Maintainer  :  Yitzchak Gale <gale@sefer.org>
-- Portability :  portable
--
-- Data types to represent timezone data used in Olson timezone files,
-- as specified by RFC 8536.
--
-- Both Version 1, 2, and 3 timezone data can be represented.

{- 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.Types
(
 -- * Olson timezone datatypes
 OlsonData(..),
 Transition(..),
 TransitionType(..),
 TtInfo(..),
 LeapInfo(..),

 -- ** Size limits for Olson timezone data
 SizeLimits(..),
 defaultLimits,
 limitsNoSolar,
 noLimits
)
where

#if MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Monoid (Monoid(..))
import Control.Monad (mplus)

-- | @OlsonData@ represents a full set of timezone data for a location.
--
-- @OlsonData@ can represent timezone data from files in Version 1, 2,
-- or 3 format.
--
-- Version 1 format files can only contain timestamp values that can
-- be represented in less than 32 bits, and cannot contain a POSIX TZ
-- string.
--
-- In a Version 2 format file, the timezone data is split into two
-- parts.  The first part contains timezone data for which all
-- timestamp values can be represented in less than 32 bits, and the
-- second part contains timezone data for which 32 bits or more are
-- required to represent timestamp values. The POSIX TZ string, if
-- present, can only be rendered in a Version 2 file, and appears
-- after both parts of the timezone data.
--
-- Version 3 format files relax certain syntax requirements for the
-- POSIX TZ string.  Since we represent the POSIX TZ string as an
-- unparsed 'String', Version 3 is identical to Version 2 for our
-- purposes.
data OlsonData =
    OlsonData {
      OlsonData -> [Transition]
olsonTransitions :: [Transition],
      OlsonData -> [TtInfo String]
olsonTypes ::       [TtInfo String],
      OlsonData -> [LeapInfo]
olsonLeaps ::       [LeapInfo],
      OlsonData -> Maybe String
olsonPosixTZ ::     (Maybe String) 
                            -- ^ Optional POSIX TZ string for
                            -- times after the last @Transition@
    }
  deriving (OlsonData -> OlsonData -> Bool
(OlsonData -> OlsonData -> Bool)
-> (OlsonData -> OlsonData -> Bool) -> Eq OlsonData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OlsonData -> OlsonData -> Bool
$c/= :: OlsonData -> OlsonData -> Bool
== :: OlsonData -> OlsonData -> Bool
$c== :: OlsonData -> OlsonData -> Bool
Eq, Int -> OlsonData -> ShowS
[OlsonData] -> ShowS
OlsonData -> String
(Int -> OlsonData -> ShowS)
-> (OlsonData -> String)
-> ([OlsonData] -> ShowS)
-> Show OlsonData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OlsonData] -> ShowS
$cshowList :: [OlsonData] -> ShowS
show :: OlsonData -> String
$cshow :: OlsonData -> String
showsPrec :: Int -> OlsonData -> ShowS
$cshowsPrec :: Int -> OlsonData -> ShowS
Show)

#if MIN_VERSION_base(4,11,0)
instance Semigroup OlsonData where
  OlsonData [Transition]
a  [TtInfo String]
b  [LeapInfo]
c  Maybe String
d <> :: OlsonData -> OlsonData -> OlsonData
<> OlsonData [Transition]
a' [TtInfo String]
b' [LeapInfo]
c' Maybe String
d' =
      [Transition]
-> [TtInfo String] -> [LeapInfo] -> Maybe String -> OlsonData
OlsonData ([Transition]
a [Transition] -> [Transition] -> [Transition]
forall a. [a] -> [a] -> [a]
++ (Transition -> Transition) -> [Transition] -> [Transition]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Transition -> Transition
shiftBy (Int -> Transition -> Transition)
-> Int -> Transition -> Transition
forall a b. (a -> b) -> a -> b
$ [TtInfo String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TtInfo String]
b) [Transition]
a')
                ([TtInfo String]
b [TtInfo String] -> [TtInfo String] -> [TtInfo String]
forall a. [a] -> [a] -> [a]
++ [TtInfo String]
b') ([LeapInfo]
c [LeapInfo] -> [LeapInfo] -> [LeapInfo]
forall a. [a] -> [a] -> [a]
++ [LeapInfo]
c') (Maybe String
d Maybe String -> Maybe String -> Maybe String
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Maybe String
d')
    where
      shiftBy :: Int -> Transition -> Transition
shiftBy Int
n Transition
trans = Transition
trans {transIndex :: Int
transIndex = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Transition -> Int
transIndex Transition
trans}

instance Monoid OlsonData where
  mempty :: OlsonData
mempty = [Transition]
-> [TtInfo String] -> [LeapInfo] -> Maybe String -> OlsonData
OlsonData [] [] [] Maybe String
forall a. Maybe a
Nothing
#else
instance Monoid OlsonData where
  mempty = OlsonData [] [] [] Nothing
  mappend (OlsonData a  b  c  d ) (OlsonData a' b' c' d') =
      OlsonData (a ++ map (shiftBy $ length b) a')
                (b ++ b') (c ++ c') (d `mplus` d')
    where
      shiftBy n trans = trans {transIndex = n + transIndex trans}
#endif

-- | A @Transition@ represents a moment when the clocks change in a
-- timezone. It consists of a Unix timestamp value that indicates the
-- exact moment in UTC when the clocks change, and the 0-based index
-- in the list of @TtInfo@ specifications for the description of the
-- new time after the clocks change.
data Transition =
       Transition
         {Transition -> Integer
transTime :: Integer, -- ^ Unix timestamp indicating the time
                                -- when the clocks change
          Transition -> Int
transIndex :: Int     -- ^ 0-based index in the list of @TtInfo@
                                -- that describes the new time
         }
  deriving (Transition -> Transition -> Bool
(Transition -> Transition -> Bool)
-> (Transition -> Transition -> Bool) -> Eq Transition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Transition -> Transition -> Bool
$c/= :: Transition -> Transition -> Bool
== :: Transition -> Transition -> Bool
$c== :: Transition -> Transition -> Bool
Eq, Int -> Transition -> ShowS
[Transition] -> ShowS
Transition -> String
(Int -> Transition -> ShowS)
-> (Transition -> String)
-> ([Transition] -> ShowS)
-> Show Transition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Transition] -> ShowS
$cshowList :: [Transition] -> ShowS
show :: Transition -> String
$cshow :: Transition -> String
showsPrec :: Int -> Transition -> ShowS
$cshowsPrec :: Int -> Transition -> ShowS
Show)

-- | A @TransitionType@ is historical information about whether the
-- official body that announced a time change specified the time of
-- the change in terms of UTC, standard time (i.e., non-summer time)
-- for the time zone, or the current wall clock time in the time
-- zone. This historical trivia may seem rather boring, but
-- unfortunately it is needed to interpret a POSIX-style TZ string
-- timezone specification correctly.
data TransitionType = Std | Wall | UTC
  deriving (TransitionType -> TransitionType -> Bool
(TransitionType -> TransitionType -> Bool)
-> (TransitionType -> TransitionType -> Bool) -> Eq TransitionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransitionType -> TransitionType -> Bool
$c/= :: TransitionType -> TransitionType -> Bool
== :: TransitionType -> TransitionType -> Bool
$c== :: TransitionType -> TransitionType -> Bool
Eq, Eq TransitionType
Eq TransitionType
-> (TransitionType -> TransitionType -> Ordering)
-> (TransitionType -> TransitionType -> Bool)
-> (TransitionType -> TransitionType -> Bool)
-> (TransitionType -> TransitionType -> Bool)
-> (TransitionType -> TransitionType -> Bool)
-> (TransitionType -> TransitionType -> TransitionType)
-> (TransitionType -> TransitionType -> TransitionType)
-> Ord TransitionType
TransitionType -> TransitionType -> Bool
TransitionType -> TransitionType -> Ordering
TransitionType -> TransitionType -> TransitionType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TransitionType -> TransitionType -> TransitionType
$cmin :: TransitionType -> TransitionType -> TransitionType
max :: TransitionType -> TransitionType -> TransitionType
$cmax :: TransitionType -> TransitionType -> TransitionType
>= :: TransitionType -> TransitionType -> Bool
$c>= :: TransitionType -> TransitionType -> Bool
> :: TransitionType -> TransitionType -> Bool
$c> :: TransitionType -> TransitionType -> Bool
<= :: TransitionType -> TransitionType -> Bool
$c<= :: TransitionType -> TransitionType -> Bool
< :: TransitionType -> TransitionType -> Bool
$c< :: TransitionType -> TransitionType -> Bool
compare :: TransitionType -> TransitionType -> Ordering
$ccompare :: TransitionType -> TransitionType -> Ordering
$cp1Ord :: Eq TransitionType
Ord, Int -> TransitionType -> ShowS
[TransitionType] -> ShowS
TransitionType -> String
(Int -> TransitionType -> ShowS)
-> (TransitionType -> String)
-> ([TransitionType] -> ShowS)
-> Show TransitionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransitionType] -> ShowS
$cshowList :: [TransitionType] -> ShowS
show :: TransitionType -> String
$cshow :: TransitionType -> String
showsPrec :: Int -> TransitionType -> ShowS
$cshowsPrec :: Int -> TransitionType -> ShowS
Show)

-- | A @TtInfo@ is a specification of local time in a timezone for
-- some period during which the clocks did not change. `abbr` is
-- @String@ if the timezone abbreviation is represented as a @String@,
-- or @Int@ if it is represented as an index into a long string of
-- null-terminated abbreviation strings (as in an Olson binary
-- timezone file).
data TtInfo abbr = 
       TtInfo
         {TtInfo abbr -> Int
tt_utoff :: Int,  -- ^ The offset of local clocks from UTC,
                            -- in seconds
          TtInfo abbr -> Bool
tt_isdst :: Bool, -- ^ True if local clocks are summer time
          TtInfo abbr -> TransitionType
tt_ttype :: TransitionType,
          TtInfo abbr -> abbr
tt_abbr :: abbr   -- ^ The timezone abbreviation string.
         }
  deriving (TtInfo abbr -> TtInfo abbr -> Bool
(TtInfo abbr -> TtInfo abbr -> Bool)
-> (TtInfo abbr -> TtInfo abbr -> Bool) -> Eq (TtInfo abbr)
forall abbr. Eq abbr => TtInfo abbr -> TtInfo abbr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TtInfo abbr -> TtInfo abbr -> Bool
$c/= :: forall abbr. Eq abbr => TtInfo abbr -> TtInfo abbr -> Bool
== :: TtInfo abbr -> TtInfo abbr -> Bool
$c== :: forall abbr. Eq abbr => TtInfo abbr -> TtInfo abbr -> Bool
Eq, Eq (TtInfo abbr)
Eq (TtInfo abbr)
-> (TtInfo abbr -> TtInfo abbr -> Ordering)
-> (TtInfo abbr -> TtInfo abbr -> Bool)
-> (TtInfo abbr -> TtInfo abbr -> Bool)
-> (TtInfo abbr -> TtInfo abbr -> Bool)
-> (TtInfo abbr -> TtInfo abbr -> Bool)
-> (TtInfo abbr -> TtInfo abbr -> TtInfo abbr)
-> (TtInfo abbr -> TtInfo abbr -> TtInfo abbr)
-> Ord (TtInfo abbr)
TtInfo abbr -> TtInfo abbr -> Bool
TtInfo abbr -> TtInfo abbr -> Ordering
TtInfo abbr -> TtInfo abbr -> TtInfo abbr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall abbr. Ord abbr => Eq (TtInfo abbr)
forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> Bool
forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> Ordering
forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> TtInfo abbr
min :: TtInfo abbr -> TtInfo abbr -> TtInfo abbr
$cmin :: forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> TtInfo abbr
max :: TtInfo abbr -> TtInfo abbr -> TtInfo abbr
$cmax :: forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> TtInfo abbr
>= :: TtInfo abbr -> TtInfo abbr -> Bool
$c>= :: forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> Bool
> :: TtInfo abbr -> TtInfo abbr -> Bool
$c> :: forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> Bool
<= :: TtInfo abbr -> TtInfo abbr -> Bool
$c<= :: forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> Bool
< :: TtInfo abbr -> TtInfo abbr -> Bool
$c< :: forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> Bool
compare :: TtInfo abbr -> TtInfo abbr -> Ordering
$ccompare :: forall abbr. Ord abbr => TtInfo abbr -> TtInfo abbr -> Ordering
$cp1Ord :: forall abbr. Ord abbr => Eq (TtInfo abbr)
Ord, Int -> TtInfo abbr -> ShowS
[TtInfo abbr] -> ShowS
TtInfo abbr -> String
(Int -> TtInfo abbr -> ShowS)
-> (TtInfo abbr -> String)
-> ([TtInfo abbr] -> ShowS)
-> Show (TtInfo abbr)
forall abbr. Show abbr => Int -> TtInfo abbr -> ShowS
forall abbr. Show abbr => [TtInfo abbr] -> ShowS
forall abbr. Show abbr => TtInfo abbr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TtInfo abbr] -> ShowS
$cshowList :: forall abbr. Show abbr => [TtInfo abbr] -> ShowS
show :: TtInfo abbr -> String
$cshow :: forall abbr. Show abbr => TtInfo abbr -> String
showsPrec :: Int -> TtInfo abbr -> ShowS
$cshowsPrec :: forall abbr. Show abbr => Int -> TtInfo abbr -> ShowS
Show)

-- | Olson timezone files can contain leap second specifications, though
-- most do not.
data LeapInfo =
       LeapInfo
         {LeapInfo -> Integer
leapTime :: Integer, -- ^ A Unix timestamp indicating the time
                               -- that the leap second occurred
          LeapInfo -> Int
leapOffset :: Int    -- ^ The new total offset of UTC from UT1
                               -- after this leap second
         }
  deriving (LeapInfo -> LeapInfo -> Bool
(LeapInfo -> LeapInfo -> Bool)
-> (LeapInfo -> LeapInfo -> Bool) -> Eq LeapInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LeapInfo -> LeapInfo -> Bool
$c/= :: LeapInfo -> LeapInfo -> Bool
== :: LeapInfo -> LeapInfo -> Bool
$c== :: LeapInfo -> LeapInfo -> Bool
Eq, Int -> LeapInfo -> ShowS
[LeapInfo] -> ShowS
LeapInfo -> String
(Int -> LeapInfo -> ShowS)
-> (LeapInfo -> String) -> ([LeapInfo] -> ShowS) -> Show LeapInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LeapInfo] -> ShowS
$cshowList :: [LeapInfo] -> ShowS
show :: LeapInfo -> String
$cshow :: LeapInfo -> String
showsPrec :: Int -> LeapInfo -> ShowS
$cshowsPrec :: Int -> LeapInfo -> ShowS
Show)

-- | The reference C implentation imposes size limits on the data
-- structures in a timezone file.
data SizeLimits = SizeLimits
       {SizeLimits -> Maybe Int
maxTimes :: Maybe Int,     -- ^ The maximum number of transition times
        SizeLimits -> Maybe Int
maxTypes :: Maybe Int,     -- ^ The maximum number of TtInfo
                                   -- clock settings
        SizeLimits -> Maybe Int
maxAbbrChars :: Maybe Int, -- ^ The maximum total number of bytes in
                                   -- all timezone abbreviations.
        SizeLimits -> Maybe Int
maxLeaps :: Maybe Int      -- ^ The maximum number of leap second
                                   -- specifications.
       }

-- | The size limits in @defaultLimits@ are taken from the file
-- tzfile.h from tzcode version 2010f. These are the limits for the C
-- implementation on many platforms.
defaultLimits :: SizeLimits
defaultLimits :: SizeLimits
defaultLimits = SizeLimits :: Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> SizeLimits
SizeLimits { maxTimes :: Maybe Int
maxTimes = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1200, maxTypes :: Maybe Int
maxTypes = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
256,
                             maxAbbrChars :: Maybe Int
maxAbbrChars = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
50, maxLeaps :: Maybe Int
maxLeaps = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
50 }

-- | @limitsNoSolar@ contains the tighter size limits imposed on some
-- platforms that do not allow timezones that are based on solar time.
limitsNoSolar :: SizeLimits
limitsNoSolar :: SizeLimits
limitsNoSolar = SizeLimits
defaultLimits { maxTypes :: Maybe Int
maxTypes = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
20 }

-- | @noLimits@ imposes no size limits. If you use @noLimits@ when
-- parsing, you may exhaust all available memory when reading a faulty
-- or malicious timezone file. If you use @noLimits@ when rendering,
-- the rendered timezone file might not be readable on some systems.
noLimits :: SizeLimits
noLimits :: SizeLimits
noLimits = Maybe Int -> Maybe Int -> Maybe Int -> Maybe Int -> SizeLimits
SizeLimits Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing