-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io/>
--
-- SPDX-License-Identifier: MPL-2.0

module Data.Time.TZInfo
  ( TZInfo(..)
  , TZIdentifier
  , utc
  -- * System's time zone database
  , loadFromSystem
  , loadFromFile
  , getCurrentTZInfo
  -- * Embedded time zone database
  , fromIdentifier
  , fromLabel
  -- ** TZLabel
  -- $tzlabel
  , TZ.TZLabel(..)
  ) where

import Control.DeepSeq (NFData)
import Data.Data (Data)
import Data.String (fromString)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Time.Zones (TZ)
import Data.Time.Zones qualified as TZ
import Data.Time.Zones.All (TZLabel)
import Data.Time.Zones.All qualified as TZ
import GHC.Generics (Generic)
import System.Directory (getSymbolicLinkTarget)
import System.Environment (lookupEnv)
import System.FilePath (makeRelative)

{- | A time zone.

There are two main ways of loading a `TZInfo`:

1. Load it from the operating system's time zone database, using `loadFromSystem`, `loadFromFile`
   or `getCurrentTZInfo`.

2. Load it from the embedded database, using `fromIdentifier` or `fromLabel`.

    This package depends on the @tzdata@ package, which comes with an
    embedded [IANA](https://www.iana.org/time-zones) time zone database.

The embedded database has the benefit of being portable, that is, it works regardless
of your operating system.
The functions to read from the system database, on the other hand, aren't portable;
`loadFromSystem` and `getCurrentTZInfo` are not likely to work on Windows.

However, you have to make sure you're always using the latest version of @tzdata@
to get the latest updates.
The operating system's time zone database is usually easier to keep up-to-date.

-}
data TZInfo = TZInfo
  { TZInfo -> TZIdentifier
tziIdentifier :: TZIdentifier
    -- ^ The time zone's identifier, e.g. @Europe/Paris@.
  , TZInfo -> TZ
tziRules :: TZ
    -- ^ The time zone's rules describing offset changes.
  }
  deriving stock (TZInfo -> TZInfo -> Bool
(TZInfo -> TZInfo -> Bool)
-> (TZInfo -> TZInfo -> Bool) -> Eq TZInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TZInfo -> TZInfo -> Bool
$c/= :: TZInfo -> TZInfo -> Bool
== :: TZInfo -> TZInfo -> Bool
$c== :: TZInfo -> TZInfo -> Bool
Eq, Int -> TZInfo -> ShowS
[TZInfo] -> ShowS
TZInfo -> String
(Int -> TZInfo -> ShowS)
-> (TZInfo -> String) -> ([TZInfo] -> ShowS) -> Show TZInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TZInfo] -> ShowS
$cshowList :: [TZInfo] -> ShowS
show :: TZInfo -> String
$cshow :: TZInfo -> String
showsPrec :: Int -> TZInfo -> ShowS
$cshowsPrec :: Int -> TZInfo -> ShowS
Show, Typeable TZInfo
Typeable TZInfo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TZInfo -> c TZInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TZInfo)
-> (TZInfo -> Constr)
-> (TZInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TZInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZInfo))
-> ((forall b. Data b => b -> b) -> TZInfo -> TZInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TZInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TZInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> TZInfo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TZInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TZInfo -> m TZInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TZInfo -> m TZInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TZInfo -> m TZInfo)
-> Data TZInfo
TZInfo -> DataType
TZInfo -> Constr
(forall b. Data b => b -> b) -> TZInfo -> TZInfo
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TZInfo -> u
forall u. (forall d. Data d => d -> u) -> TZInfo -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TZInfo -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TZInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZInfo -> m TZInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZInfo -> m TZInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZInfo -> c TZInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZInfo -> m TZInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZInfo -> m TZInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZInfo -> m TZInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZInfo -> m TZInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZInfo -> m TZInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZInfo -> m TZInfo
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TZInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TZInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TZInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TZInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TZInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TZInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TZInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TZInfo -> r
gmapT :: (forall b. Data b => b -> b) -> TZInfo -> TZInfo
$cgmapT :: (forall b. Data b => b -> b) -> TZInfo -> TZInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZInfo)
dataTypeOf :: TZInfo -> DataType
$cdataTypeOf :: TZInfo -> DataType
toConstr :: TZInfo -> Constr
$ctoConstr :: TZInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZInfo -> c TZInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZInfo -> c TZInfo
Data, (forall x. TZInfo -> Rep TZInfo x)
-> (forall x. Rep TZInfo x -> TZInfo) -> Generic TZInfo
forall x. Rep TZInfo x -> TZInfo
forall x. TZInfo -> Rep TZInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TZInfo x -> TZInfo
$cfrom :: forall x. TZInfo -> Rep TZInfo x
Generic)
  deriving anyclass TZInfo -> ()
(TZInfo -> ()) -> NFData TZInfo
forall a. (a -> ()) -> NFData a
rnf :: TZInfo -> ()
$crnf :: TZInfo -> ()
NFData

-- | A time zone's identifier, e.g. @Europe/Paris@.
type TZIdentifier = Text

-- | The UTC time zone.
utc :: TZInfo
utc :: TZInfo
utc = TZIdentifier -> TZ -> TZInfo
TZInfo TZIdentifier
"UTC" TZ
TZ.utcTZ

----------------------------------------------------------------------------
-- System's time zone database
----------------------------------------------------------------------------

-- | Looks for the time zone file in the system time zone directory, which is
-- @\/usr\/share\/zoneinfo@, or if the @TZDIR@ environment variable is
-- set, then there.
--
-- Note, this is unlikely to work on non-posix systems (e.g.,
-- Windows).
-- Use `fromIdentifier`, `fromLabel` or `loadFromFile` instead.
--
-- Throws an `Control.Exception.IOException` if the identifier is not found.
loadFromSystem :: TZIdentifier -> IO TZInfo
loadFromSystem :: TZIdentifier -> IO TZInfo
loadFromSystem TZIdentifier
ident =
  TZIdentifier -> TZ -> TZInfo
TZInfo TZIdentifier
ident (TZ -> TZInfo) -> IO TZ -> IO TZInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO TZ
TZ.loadSystemTZ (TZIdentifier -> String
T.unpack TZIdentifier
ident)

-- | Reads and parses a time zone information file (in @tzfile(5)@
-- aka. Olson file format).
loadFromFile :: TZIdentifier -> FilePath -> IO TZInfo
loadFromFile :: TZIdentifier -> String -> IO TZInfo
loadFromFile TZIdentifier
ident String
filepath =
  TZIdentifier -> TZ -> TZInfo
TZInfo TZIdentifier
ident (TZ -> TZInfo) -> IO TZ -> IO TZInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO TZ
TZ.loadTZFromFile String
filepath

-- | Returns the local `TZInfo` based on the @TZ@ and @TZDIR@
-- environment variables.
--
-- See @tzset(3)@ for details, but basically:
--
-- * If @TZ@ environment variable is unset, we use @\/etc\/localtime@.
-- * If @TZ@ is set, but empty, we use `utc`.
-- * If @TZ@ is set and not empty, we use `loadFromSystem` to read that file.
getCurrentTZInfo :: IO TZInfo
getCurrentTZInfo :: IO TZInfo
getCurrentTZInfo =
  String -> IO (Maybe String)
lookupEnv String
"TZ" IO (Maybe String) -> (Maybe String -> IO TZInfo) -> IO TZInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe String
Nothing -> do
      String
filePath <- String -> IO String
getSymbolicLinkTarget String
"/etc/localtime"
      let ident :: TZIdentifier
ident = forall a. IsString a => String -> a
fromString @TZIdentifier (String -> TZIdentifier) -> String -> TZIdentifier
forall a b. (a -> b) -> a -> b
$ String -> ShowS
makeRelative String
"/usr/share/zoneinfo" String
filePath
      TZ
tz <- String -> IO TZ
TZ.loadTZFromFile String
filePath
      pure $ TZIdentifier -> TZ -> TZInfo
TZInfo TZIdentifier
ident TZ
tz
    Just String
"" -> TZInfo -> IO TZInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure TZInfo
utc
    Just String
ident -> TZIdentifier -> TZ -> TZInfo
TZInfo (String -> TZIdentifier
forall a. IsString a => String -> a
fromString String
ident) (TZ -> TZInfo) -> IO TZ -> IO TZInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO TZ
TZ.loadSystemTZ String
ident

----------------------------------------------------------------------------
-- Embedded time zone database
----------------------------------------------------------------------------

-- | Look up a time zone in the @tzdata@'s embedded database.
fromIdentifier :: TZIdentifier -> Maybe TZInfo
fromIdentifier :: TZIdentifier -> Maybe TZInfo
fromIdentifier TZIdentifier
ident =
  TZIdentifier -> TZ -> TZInfo
TZInfo TZIdentifier
ident (TZ -> TZInfo) -> Maybe TZ -> Maybe TZInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe TZ
TZ.tzByName (TZIdentifier -> ByteString
T.encodeUtf8 TZIdentifier
ident)

-- | Retrieves the time zone info for a "canonical" time zone
-- from @tzdata@'s embedded database.
fromLabel :: TZLabel -> TZInfo
fromLabel :: TZLabel -> TZInfo
fromLabel TZLabel
label =
  TZIdentifier -> TZ -> TZInfo
TZInfo
    (ByteString -> TZIdentifier
T.decodeUtf8 (ByteString -> TZIdentifier) -> ByteString -> TZIdentifier
forall a b. (a -> b) -> a -> b
$ TZLabel -> ByteString
TZ.toTZName TZLabel
label)
    (TZLabel -> TZ
TZ.tzByLabel TZLabel
label)

{- $tzlabel

`TZLabel` enumerates all the "canonical" time zones from the IANA database.

For example, the @2022a@ version of the IANA database defines @Europe/London@ as a
"canonical" time zone and @Europe/Jersey@, @Europe/Guernsey@ and @Europe/Isle_of_Man@ as
links to @Europe/London@.

@
Zone	Europe\/London	-0:01:15 -	LMT	1847 Dec  1  0:00s
			 ...
Link	Europe\/London	Europe\/Jersey
Link	Europe\/London	Europe\/Guernsey
Link	Europe\/London	Europe\/Isle_of_Man
@

Note that `fromLabel` only supports canonical time zone identifiers, whereas
`fromIdentifier` supports all time zone identifiers.

-}