-- 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
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
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
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. 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 -> ()
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 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 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" 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 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
"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TZInfo
utc
    Just String
ident -> TZIdentifier -> TZ -> TZInfo
TZInfo (forall a. IsString a => String -> a
fromString String
ident) 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 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 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.

-}