-----------------------------------------------------------------------------
-- |
-- Module      :  Data.HodaTime.TimeZone
-- Copyright   :  (C) 2017 Jason Johnson
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>
-- Stability   :  experimental
-- Portability :  POSIX, Windows
--
-- This module deals with loading TimeZone information with which to construct ZonedDateTimes.
----------------------------------------------------------------------------
module Data.HodaTime.TimeZone
(
  -- * Types
   TimeZone
  -- * Constructors
  ,utc
  ,localZone
  ,timeZone
  ,availableZones
)
where

import Data.HodaTime.TimeZone.Internal
import Data.HodaTime.TimeZone.Platform

-- | Load the UTC time zone
utc :: IO TimeZone
utc :: IO TimeZone
utc = do
  (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM) <- IO (UtcTransitionsMap, CalDateTransitionsMap)
loadUTC
  TimeZone -> IO TimeZone
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> IO TimeZone) -> TimeZone -> IO TimeZone
forall a b. (a -> b) -> a -> b
$ TZIdentifier
-> UtcTransitionsMap -> CalDateTransitionsMap -> TimeZone
TimeZone TZIdentifier
UTC UtcTransitionsMap
utcM CalDateTransitionsMap
calDateM

-- | Load the specified time zone.  The time zone name should be in the format returned by `availableZones`
timeZone :: String -> IO TimeZone
timeZone :: String -> IO TimeZone
timeZone String
tzName = do
  (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM) <- String -> IO (UtcTransitionsMap, CalDateTransitionsMap)
loadTimeZone String
tzName
  TimeZone -> IO TimeZone
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> IO TimeZone) -> TimeZone -> IO TimeZone
forall a b. (a -> b) -> a -> b
$ TZIdentifier
-> UtcTransitionsMap -> CalDateTransitionsMap -> TimeZone
TimeZone (String -> TZIdentifier
Zone String
tzName) UtcTransitionsMap
utcM CalDateTransitionsMap
calDateM

-- | Load the locally configured time zone (operating system configuration dependant)
localZone :: IO TimeZone
localZone :: IO TimeZone
localZone = do
  (UtcTransitionsMap
utcM, CalDateTransitionsMap
calDateM, String
tzName) <- IO (UtcTransitionsMap, CalDateTransitionsMap, String)
loadLocalZone
  TimeZone -> IO TimeZone
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeZone -> IO TimeZone) -> TimeZone -> IO TimeZone
forall a b. (a -> b) -> a -> b
$ TZIdentifier
-> UtcTransitionsMap -> CalDateTransitionsMap -> TimeZone
TimeZone (String -> TZIdentifier
Zone String
tzName) UtcTransitionsMap
utcM CalDateTransitionsMap
calDateM

-- | List all time zones available to hodatime
availableZones :: IO [String]
availableZones :: IO [String]
availableZones = IO [String]
loadAvailableZones