{-# OPTIONS_GHC -Wno-missing-import-lists #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | This module provides functions for reading time strings. We also provide
-- functions for converting between timezones.
--
-- @since 0.1
module Kairos
  ( -- * High-level parsing/conversion
    readConvertTime,
    readTime,
    convertTime,

    -- * Low-level functions

    -- ** Parsing time strings
    readTimeFormatM,
    readTimeFormat,

    -- ** Converting ZonedTime
    convertZoned,
    convertLocalToZoned,

    -- * Types
    Date (..),
    TimeFormat (..),
    TimeReader (..),
    TZInput (..),

    -- ** Re-exports
    TZLabel (..),
    ZonedTime (..),

    -- ** Exceptions
    ParseTimeException (..),
    ParseTZInputException (..),
    LocalTimeZoneException (..),
    LocalTZException (..),
    LocalSystemTimeException (..),
  )
where

import Control.Applicative (asum)
import Control.Exception.Utils (catchSync)
import Control.Monad.Catch
  ( MonadCatch,
    MonadThrow,
    throwM,
  )
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.String (IsString)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (Day)
import Data.Time.Clock (UTCTime)
import Data.Time.Format (ParseTime)
import Data.Time.Format qualified as Format
import Data.Time.LocalTime
  ( LocalTime (LocalTime),
    TimeOfDay,
    TimeZone,
    ZonedTime
      ( ZonedTime,
        zonedTimeToLocalTime,
        zonedTimeZone
      ),
  )
import Data.Time.LocalTime qualified as Local
import Data.Time.Zones (TZ)
import Data.Time.Zones qualified as Zones
import Data.Time.Zones.All (TZLabel (..))
import Data.Time.Zones.All qualified as All
import Effects.Time (MonadTime (getSystemZonedTime, getTimeZone, loadLocalTZ))
import GHC.Stack (HasCallStack)
import Kairos.Types.Date (Date (MkDateString))
import Kairos.Types.Exception
  ( LocalSystemTimeException (MkLocalSystemTimeException),
    LocalTZException (MkLocalTZException),
    LocalTimeZoneException (MkLocalTimeZoneException),
    ParseTZInputException (MkParseTZInputException),
    ParseTimeException (MkParseTimeException),
  )
import Kairos.Types.TZInput (TZInput (TZActual, TZDatabase), locale)
import Kairos.Types.TimeFormat
  ( TimeFormat (MkTimeFormat, unTimeFormat),
  )
import Kairos.Types.TimeReader
  ( TimeReader
      ( MkTimeReader,
        date,
        formats,
        srcTZ,
        timeString
      ),
  )

-- | Reads the given time string based on the source 'TimeReader' and
-- converts to the destination timezone. This is the composition of
-- 'readTime' and 'convertTime'. If the source is 'Nothing' then we read
-- the local system time. Similarly, if the dest is 'Nothing', we convert
-- to the local system timezone.
--
-- __Throws:__
--
-- * 'ParseTimeException': Error parsing the time string.
-- * 'LocalTimeZoneException': Error retrieving local timezone.
-- * 'LocalTZException': Error retrieving local tz_database name.
-- * 'LocalSystemTimeException': Error retrieving local system time.
--
-- @since 0.1
readConvertTime ::
  ( HasCallStack,
    MonadCatch m,
    MonadTime m
  ) =>
  -- | Source time.
  Maybe TimeReader ->
  -- | Dest timezone.
  Maybe TZInput ->
  -- | Converted time.
  m ZonedTime
readConvertTime :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
Maybe TimeReader -> Maybe TZInput -> m ZonedTime
readConvertTime Maybe TimeReader
mtimeReader Maybe TZInput
destTZ =
  Maybe TimeReader -> m ZonedTime
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
Maybe TimeReader -> m ZonedTime
readTime Maybe TimeReader
mtimeReader m ZonedTime -> (ZonedTime -> m ZonedTime) -> m ZonedTime
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ZonedTime -> Maybe TZInput -> m ZonedTime
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
ZonedTime -> Maybe TZInput -> m ZonedTime
`convertTime` Maybe TZInput
destTZ)

-- | Reads a time based on the 'TimeReader'. If given 'Nothing' we read the
-- local system time instead.
--
-- __Throws:__
--
-- * 'ParseTimeException': Error parsing the time string.
-- * 'LocalTimeZoneException': Error retrieving local timezone.
-- * 'LocalTZException': Error retrieving local tz_database name.
-- * 'LocalSystemTimeException': Error retrieving local system time.
--
-- @since 0.1
readTime ::
  ( HasCallStack,
    MonadCatch m,
    MonadTime m
  ) =>
  -- | Optional time reader.
  Maybe TimeReader ->
  -- | Read time.
  m ZonedTime
readTime :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
Maybe TimeReader -> m ZonedTime
readTime (Just TimeReader
timeReader) = TimeReader -> m ZonedTime
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
TimeReader -> m ZonedTime
readTimeString TimeReader
timeReader
readTime Maybe TimeReader
Nothing = m ZonedTime
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
m ZonedTime
getSystemZonedTimeKairos

-- | Converts the given time to the destination timezone. If no destination
-- timezone is given then we convert to the local system timezone.
--
-- __Throws:__
--
-- * 'ParseTimeException': Error parsing the time string.
-- * 'LocalTimeZoneException': Error retrieving local timezone.
--
-- @since 0.1
convertTime ::
  ( HasCallStack,
    MonadCatch m,
    MonadTime m
  ) =>
  -- | Time to convert.
  ZonedTime ->
  -- | Optional destination timezone.
  Maybe TZInput ->
  -- | Converted time.
  m ZonedTime
convertTime :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
ZonedTime -> Maybe TZInput -> m ZonedTime
convertTime ZonedTime
inTime Maybe TZInput
Nothing = do
  let inTimeUtc :: UTCTime
inTimeUtc = ZonedTime -> UTCTime
Local.zonedTimeToUTC ZonedTime
inTime
  TimeZone
currTZ <- UTCTime -> m TimeZone
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
UTCTime -> m TimeZone
getTimeZoneKairos UTCTime
inTimeUtc
  pure $ TimeZone -> UTCTime -> ZonedTime
Local.utcToZonedTime TimeZone
currTZ UTCTime
inTimeUtc
convertTime ZonedTime
inTime (Just TZInput
tzOut) = ZonedTime -> m ZonedTime
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZonedTime -> m ZonedTime) -> ZonedTime -> m ZonedTime
forall a b. (a -> b) -> a -> b
$ ZonedTime -> TZInput -> ZonedTime
convertZoned ZonedTime
inTime TZInput
tzOut

readTimeString ::
  forall m.
  ( HasCallStack,
    MonadCatch m,
    MonadTime m
  ) =>
  TimeReader ->
  m ZonedTime
readTimeString :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
TimeReader -> m ZonedTime
readTimeString TimeReader
timeReader = case (TimeReader
timeReader.date, TimeReader
timeReader.srcTZ) of
  (Maybe Date
Nothing, Maybe TZInput
Nothing) -> m ZonedTime
HasCallStack => m ZonedTime
onNoInputs
  (Maybe Date
Nothing, Just TZInput
srcTZ) -> HasCallStack => TZInput -> m ZonedTime
TZInput -> m ZonedTime
onSrcTZ TZInput
srcTZ
  (Just Date
date, Maybe TZInput
Nothing) -> HasCallStack => Date -> m ZonedTime
Date -> m ZonedTime
onDate Date
date
  (Just Date
date, Just TZInput
srcTZ) -> HasCallStack => Date -> TZInput -> m ZonedTime
Date -> TZInput -> m ZonedTime
onDateAndSrcTZ Date
date TZInput
srcTZ
  where
    -- 1. We are given no date nor tz info. Interpret given TimeOfDay in
    -- current system timezone.
    onNoInputs :: (HasCallStack) => m ZonedTime
    onNoInputs :: HasCallStack => m ZonedTime
onNoInputs = do
      ZonedTime (LocalTime Day
currSysDay TimeOfDay
_) TimeZone
currSysTz <- m ZonedTime
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
m ZonedTime
getSystemZonedTimeKairos
      TimeOfDay
givenTod <- NonEmpty TimeFormat -> Text -> m TimeOfDay
forall t (m :: * -> *).
(HasCallStack, MonadThrow m, ParseTime t) =>
NonEmpty TimeFormat -> Text -> m t
readTimeFormatM NonEmpty TimeFormat
formats TimeReader
timeReader.timeString
      pure $ LocalTime -> TimeZone -> ZonedTime
ZonedTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
currSysDay TimeOfDay
givenTod) TimeZone
currSysTz

    -- 2. We are given no date but some source timezone info. Interpret given
    -- TimeOfDay as current source timezone.
    onSrcTZ :: (HasCallStack) => TZInput -> m ZonedTime
    onSrcTZ :: HasCallStack => TZInput -> m ZonedTime
onSrcTZ TZInput
src = do
      ZonedTime
currSysZonedTime <- m ZonedTime
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
m ZonedTime
getSystemZonedTimeKairos
      let ZonedTime (LocalTime Day
currSrcDay TimeOfDay
_) TimeZone
curSrcTz =
            ZonedTime -> TZInput -> ZonedTime
convertZoned ZonedTime
currSysZonedTime TZInput
src
      TimeOfDay
givenTod <- NonEmpty TimeFormat -> Text -> m TimeOfDay
forall t (m :: * -> *).
(HasCallStack, MonadThrow m, ParseTime t) =>
NonEmpty TimeFormat -> Text -> m t
readTimeFormatM NonEmpty TimeFormat
formats TimeReader
timeReader.timeString
      pure $ LocalTime -> TimeZone -> ZonedTime
ZonedTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
currSrcDay TimeOfDay
givenTod) TimeZone
curSrcTz

    -- 3. We are given date but no timezone info. Interpret given TimeOfDay in
    -- system timezone at that date.
    onDate :: (HasCallStack) => Date -> m ZonedTime
    onDate :: HasCallStack => Date -> m ZonedTime
onDate (MkDateString Text
date) = do
      Day
givenDay <- forall t (m :: * -> *).
(HasCallStack, MonadThrow m, ParseTime t) =>
NonEmpty TimeFormat -> Text -> m t
readTimeFormatM @Day NonEmpty TimeFormat
dayFmt Text
date
      TimeOfDay
givenTod <- forall t (m :: * -> *).
(HasCallStack, MonadThrow m, ParseTime t) =>
NonEmpty TimeFormat -> Text -> m t
readTimeFormatM @TimeOfDay NonEmpty TimeFormat
formats TimeReader
timeReader.timeString
      let givenLocalTime :: LocalTime
givenLocalTime = Day -> TimeOfDay -> LocalTime
LocalTime Day
givenDay TimeOfDay
givenTod

      -- see NOTE: [LocalTZException error message]
      TZ
localTZ <- m TZ
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
m TZ
loadLocalTZKairos

      let givenUtcTime :: UTCTime
givenUtcTime = TZ -> LocalTime -> UTCTime
Zones.localTimeToUTCTZ TZ
localTZ LocalTime
givenLocalTime
          timeZone :: TimeZone
timeZone = TZ -> UTCTime -> TimeZone
Zones.timeZoneForUTCTime TZ
localTZ UTCTime
givenUtcTime

      ZonedTime -> m ZonedTime
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZonedTime -> m ZonedTime) -> ZonedTime -> m ZonedTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
givenLocalTime TimeZone
timeZone

    -- 4. We are given date and timezone info. Interpret given TimeOfDay in
    -- source timezone at that date.
    onDateAndSrcTZ :: (HasCallStack) => Date -> TZInput -> m ZonedTime
    onDateAndSrcTZ :: HasCallStack => Date -> TZInput -> m ZonedTime
onDateAndSrcTZ (MkDateString Text
date) TZInput
srcTZ = do
      Day
givenDay <- forall t (m :: * -> *).
(HasCallStack, MonadThrow m, ParseTime t) =>
NonEmpty TimeFormat -> Text -> m t
readTimeFormatM @Day NonEmpty TimeFormat
dayFmt Text
date
      TimeOfDay
givenTod <- forall t (m :: * -> *).
(HasCallStack, MonadThrow m, ParseTime t) =>
NonEmpty TimeFormat -> Text -> m t
readTimeFormatM @TimeOfDay NonEmpty TimeFormat
formats TimeReader
timeReader.timeString
      let givenLocalTime :: LocalTime
givenLocalTime = Day -> TimeOfDay -> LocalTime
LocalTime Day
givenDay TimeOfDay
givenTod
      ZonedTime -> m ZonedTime
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ZonedTime -> m ZonedTime) -> ZonedTime -> m ZonedTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TZInput -> ZonedTime
convertLocalToZoned LocalTime
givenLocalTime TZInput
srcTZ

    formats :: NonEmpty TimeFormat
    formats :: NonEmpty TimeFormat
formats = TimeReader
timeReader.formats

    dayFmt :: NonEmpty TimeFormat
    dayFmt :: NonEmpty TimeFormat
dayFmt = TimeFormat -> NonEmpty TimeFormat
forall a. a -> NonEmpty a
NE.singleton TimeFormat
forall s. IsString s => s
dateString

    dateString :: (IsString s) => s
    dateString :: forall s. IsString s => s
dateString = s
"%Y-%m-%d"

-- | 'readTimeFormatM' that throws 'ParseTimeException'.
--
-- @since 0.1
readTimeFormatM ::
  forall t m.
  ( HasCallStack,
    MonadThrow m,
    ParseTime t
  ) =>
  -- | Formats.
  NonEmpty TimeFormat ->
  -- | Text to parse.
  Text ->
  m t
readTimeFormatM :: forall t (m :: * -> *).
(HasCallStack, MonadThrow m, ParseTime t) =>
NonEmpty TimeFormat -> Text -> m t
readTimeFormatM NonEmpty TimeFormat
formats Text
timeStr = case NonEmpty TimeFormat -> Text -> Maybe t
forall t. ParseTime t => NonEmpty TimeFormat -> Text -> Maybe t
readTimeFormat NonEmpty TimeFormat
formats Text
timeStr of
  Maybe t
Nothing -> ParseTimeException -> m t
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (ParseTimeException -> m t) -> ParseTimeException -> m t
forall a b. (a -> b) -> a -> b
$ NonEmpty TimeFormat -> Text -> ParseTimeException
MkParseTimeException NonEmpty TimeFormat
formats Text
timeStr
  Just t
t -> t -> m t
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure t
t

-- | @readTimeFormat locale format timeStr@ attempts to parse the @timeStr@ given
-- the expected @format@. No timezone is assumed, so if it is left off then
-- the result is UTC.
--
-- @since 0.1
readTimeFormat :: (ParseTime t) => NonEmpty TimeFormat -> Text -> Maybe t
readTimeFormat :: forall t. ParseTime t => NonEmpty TimeFormat -> Text -> Maybe t
readTimeFormat NonEmpty TimeFormat
formats Text
timeStr =
  NonEmpty (Maybe t) -> Maybe t
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum (String -> Maybe t
parseFn (String -> Maybe t)
-> (TimeFormat -> String) -> TimeFormat -> Maybe t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeFormat -> String
toFmtStr (TimeFormat -> Maybe t)
-> NonEmpty TimeFormat -> NonEmpty (Maybe t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty TimeFormat
formats)
  where
    parseFn :: String -> Maybe t
parseFn String
f = Bool -> TimeLocale -> String -> String -> Maybe t
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
Format.parseTimeM Bool
True TimeLocale
locale String
f String
timeStr'

    toFmtStr :: TimeFormat -> String
    toFmtStr :: TimeFormat -> String
toFmtStr = Text -> String
T.unpack (Text -> String) -> (TimeFormat -> Text) -> TimeFormat -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.unTimeFormat)
    timeStr' :: String
timeStr' = Text -> String
T.unpack Text
timeStr

-- | Converts a local time to the given timezone.
--
-- @since 0.1
convertLocalToZoned :: LocalTime -> TZInput -> ZonedTime
convertLocalToZoned :: LocalTime -> TZInput -> ZonedTime
convertLocalToZoned LocalTime
localTime TZInput
tzInput =
  case TZInput
tzInput of
    -- We have a TZLabel. We need to perform to/from UTC conversions to get
    -- the correct time, because the Label -> TimeZone function is not
    -- constant (consider e.g. daylight savings).
    TZDatabase TZLabel
label -> (TZ -> LocalTime -> UTCTime) -> LocalTime -> TZLabel -> ZonedTime
forall a. (TZ -> a -> UTCTime) -> a -> TZLabel -> ZonedTime
convertFromLabel TZ -> LocalTime -> UTCTime
Zones.localTimeToUTCTZ LocalTime
localTime TZLabel
label
    -- If we have a TimeZone then we can just create the ZonedTime directly.
    -- No need for any conversions.
    TZActual TimeZone
timeZone -> LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
localTime TimeZone
timeZone

-- | Converts a zoned time to the given timezone.
--
-- @since 0.1
convertZoned :: ZonedTime -> TZInput -> ZonedTime
convertZoned :: ZonedTime -> TZInput -> ZonedTime
convertZoned ZonedTime
zonedTime TZInput
tzInput =
  case TZInput
tzInput of
    TZDatabase TZLabel
label -> (TZ -> ZonedTime -> UTCTime) -> ZonedTime -> TZLabel -> ZonedTime
forall a. (TZ -> a -> UTCTime) -> a -> TZLabel -> ZonedTime
convertFromLabel TZ -> ZonedTime -> UTCTime
forall a. a -> ZonedTime -> UTCTime
f ZonedTime
zonedTime TZLabel
label
    TZActual TimeZone
timeZone -> ZonedTime -> TimeZone -> ZonedTime
convertFromActual ZonedTime
zonedTime TimeZone
timeZone
  where
    f :: forall a. a -> ZonedTime -> UTCTime
    f :: forall a. a -> ZonedTime -> UTCTime
f = (ZonedTime -> UTCTime) -> a -> ZonedTime -> UTCTime
forall a b. a -> b -> a
const ZonedTime -> UTCTime
Local.zonedTimeToUTC

-- | Converts the ZonedTime to UTCTime and finally the requested TimeZone.
--
-- The parameter 'TimeZone' is the destination.
convertFromActual :: ZonedTime -> TimeZone -> ZonedTime
convertFromActual :: ZonedTime -> TimeZone -> ZonedTime
convertFromActual ZonedTime
zt TimeZone
timeZone = TimeZone -> UTCTime -> ZonedTime
Local.utcToZonedTime TimeZone
timeZone UTCTime
utcTime
  where
    -- Convert to UTC.
    utcTime :: UTCTime
utcTime = ZonedTime -> UTCTime
Local.zonedTimeToUTC ZonedTime
zt

-- | Converts some time ('Data.Time.LocalTime' or 'Data.Time.ZonedTime') to
-- 'UTCTime' then finally a ZonedTime based on the given 'TZLabel'.
--
-- ZonedTime is expected to pass a toUtcTime function that ignored the
-- 'TZ' parameter, since it already has its own time zone info. the 'TZLabel'
-- is used purely to convert the destination.
--
-- LocalTime, on the other hand, is expected to use 'TZ' since it does not
-- have its own time zone info. This may seem silly, since we are using the
-- parameter to TZLabel to determine the (source) LocalTime's zone, converting
-- to UTC, then converting to (dest) ZonedTime based on the same zone. Why
-- are we "converting" to the same time zone?
--
-- There may well be a more direct method, but we have to do _something_
-- non-trivial here because the actual TimeZone will vary with the LocalTime
-- (e.g. daylight savings, leap seconds). Thus we first get a zoned time (UTC)
-- with the LocalTime and TZLabel. Then we convert that to the TimeZone of our
-- choice. The returned ZonedTime's LocalTime should be very similar, with the
-- only differences due to the aforementioned issues.
convertFromLabel :: (TZ -> a -> UTCTime) -> a -> TZLabel -> ZonedTime
convertFromLabel :: forall a. (TZ -> a -> UTCTime) -> a -> TZLabel -> ZonedTime
convertFromLabel TZ -> a -> UTCTime
toUtcTime a
t TZLabel
tzLabel = TimeZone -> UTCTime -> ZonedTime
Local.utcToZonedTime TimeZone
timeZone UTCTime
utcTime
  where
    -- This is a TZ i.e. the preliminary timezone corresponding to our
    -- label e.g. America/New_York -> TZ. This type is a stepping stone
    -- to the actual ZonedTime we want.
    tz :: TZ
tz = TZLabel -> TZ
All.tzByLabel TZLabel
tzLabel
    -- Convert to UTC. Localtime will use the tz param to derive TimeZone
    -- information. ZonedTime will ignore it as it already carries TimeZone
    -- info.
    utcTime :: UTCTime
utcTime = TZ -> a -> UTCTime
toUtcTime TZ
tz a
t
    -- Get the final TimeZone from TZ and the UTC time. We need
    -- the time as the TimeZone can vary with the actual time e.g.
    -- America/New_York -> EST / EDT.
    timeZone :: TimeZone
timeZone = TZ -> UTCTime -> TimeZone
Zones.timeZoneForUTCTime TZ
tz UTCTime
utcTime

-- These get*Kairos functions are just wrapperes for upstream functions that
-- we wrap in our own exceptions.

getSystemZonedTimeKairos ::
  ( HasCallStack,
    MonadCatch m,
    MonadTime m
  ) =>
  m ZonedTime
getSystemZonedTimeKairos :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
m ZonedTime
getSystemZonedTimeKairos =
  m ZonedTime
forall (m :: * -> *). (MonadTime m, HasCallStack) => m ZonedTime
getSystemZonedTime m ZonedTime -> (SomeException -> m ZonedTime) -> m ZonedTime
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchSync` (LocalSystemTimeException -> m ZonedTime
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (LocalSystemTimeException -> m ZonedTime)
-> (SomeException -> LocalSystemTimeException)
-> SomeException
-> m ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> LocalSystemTimeException
forall e. Exception e => e -> LocalSystemTimeException
MkLocalSystemTimeException)

getTimeZoneKairos ::
  ( HasCallStack,
    MonadCatch m,
    MonadTime m
  ) =>
  UTCTime ->
  m TimeZone
getTimeZoneKairos :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
UTCTime -> m TimeZone
getTimeZoneKairos UTCTime
utc =
  UTCTime -> m TimeZone
forall (m :: * -> *).
(MonadTime m, HasCallStack) =>
UTCTime -> m TimeZone
getTimeZone UTCTime
utc m TimeZone -> (SomeException -> m TimeZone) -> m TimeZone
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchSync` (LocalTimeZoneException -> m TimeZone
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (LocalTimeZoneException -> m TimeZone)
-> (SomeException -> LocalTimeZoneException)
-> SomeException
-> m TimeZone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> LocalTimeZoneException
forall e. Exception e => e -> LocalTimeZoneException
MkLocalTimeZoneException)

-- | NOTE: [LocalTZException error message]
--
-- The exception here, LocalTZException, has a highly specific message
-- that only applies when we are trying to find the user's local TZ
-- because it was not explicitly given.
--
-- This is fine because this function is only called in the following scenario:
--
-- - User supplies a 'time string' but no --source, hence we need to interpret
--   it in the local timezone.
--
-- - User supplies --date, hence we cannot take the _current_ system timezone,
--   as it may not be correct for the given date. Thus we use time-agnostic
--   loadLocalTZ (tz_database).
--
-- This is not always reliable e.g. windows, so it pays to have a good error
-- message. But note that the error message might need to change if this
-- function was used more widely.
loadLocalTZKairos :: (HasCallStack, MonadCatch m, MonadTime m) => m TZ
loadLocalTZKairos :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadTime m) =>
m TZ
loadLocalTZKairos =
  m TZ
forall (m :: * -> *). (MonadTime m, HasCallStack) => m TZ
loadLocalTZ m TZ -> (SomeException -> m TZ) -> m TZ
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
`catchSync` (LocalTZException -> m TZ
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (LocalTZException -> m TZ)
-> (SomeException -> LocalTZException) -> SomeException -> m TZ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> LocalTZException
forall e. Exception e => e -> LocalTZException
MkLocalTZException)