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

{-# OPTIONS_HADDOCK not-home #-}

{-# LANGUAGE CPP #-}

module Data.Time.TZTime.Internal where

import Control.Applicative (optional)
import Control.DeepSeq (NFData)
import Control.Exception.Safe (Exception(..), MonadThrow, throwM)
import Control.Monad.Except (MonadError, throwError)
import Data.Data (Data)
import Data.Fixed (Fixed(..), Pico)
import Data.Function ((&))
import Data.Functor (void, (<&>))
import Data.List.NonEmpty (NonEmpty(..))
import Data.List.NonEmpty qualified as NE
import Data.Maybe (fromJust)
import Data.String (fromString)
import Data.Text qualified as T
import Data.Time (UTCTime, addUTCTime, secondsToNominalDiffTime)
import Data.Time qualified as Time
import Data.Time.Clock.POSIX (POSIXTime, posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
import Data.Time.Compat (pattern YearMonthDay)
import Data.Time.Format.ISO8601 (iso8601Show)
import Data.Time.LocalTime
import Data.Time.TZInfo (TZIdentifier, TZInfo(..), fromIdentifier)
import Data.Time.Zones (LocalToUTCResult(..))
import Data.Time.Zones qualified as TZ
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Text.ParserCombinators.ReadP (ReadP)
import Text.ParserCombinators.ReadP qualified as P

import Language.Haskell.TH.Syntax (Q, liftTyped)
#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH.Syntax (Code, Quote)
#else
import Language.Haskell.TH.Syntax (TExp)
#endif

{-# ANN module ("HLint: ignore Use fewer imports" :: String) #-}

----------------------------------------------------------------------------
-- TZTime
----------------------------------------------------------------------------

-- | A valid and unambiguous point in time in some time zone.
data TZTime = UnsafeTZTime
  { TZTime -> LocalTime
tztLocalTime :: LocalTime
  , TZTime -> TZInfo
tztTZInfo :: TZInfo
  , TZTime -> TimeZone
tztOffset :: Time.TimeZone
  }
  deriving stock (TZTime -> TZTime -> Bool
(TZTime -> TZTime -> Bool)
-> (TZTime -> TZTime -> Bool) -> Eq TZTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TZTime -> TZTime -> Bool
$c/= :: TZTime -> TZTime -> Bool
== :: TZTime -> TZTime -> Bool
$c== :: TZTime -> TZTime -> Bool
Eq, Typeable TZTime
Typeable TZTime
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TZTime -> c TZTime)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TZTime)
-> (TZTime -> Constr)
-> (TZTime -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TZTime))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZTime))
-> ((forall b. Data b => b -> b) -> TZTime -> TZTime)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TZTime -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TZTime -> r)
-> (forall u. (forall d. Data d => d -> u) -> TZTime -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TZTime -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TZTime -> m TZTime)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TZTime -> m TZTime)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TZTime -> m TZTime)
-> Data TZTime
TZTime -> DataType
TZTime -> Constr
(forall b. Data b => b -> b) -> TZTime -> TZTime
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) -> TZTime -> u
forall u. (forall d. Data d => d -> u) -> TZTime -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TZTime -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TZTime -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZTime -> m TZTime
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZTime -> m TZTime
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZTime
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZTime -> c TZTime
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZTime)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZTime)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZTime -> m TZTime
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZTime -> m TZTime
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZTime -> m TZTime
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZTime -> m TZTime
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZTime -> m TZTime
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZTime -> m TZTime
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TZTime -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TZTime -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TZTime -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TZTime -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TZTime -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> TZTime -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TZTime -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> TZTime -> r
gmapT :: (forall b. Data b => b -> b) -> TZTime -> TZTime
$cgmapT :: (forall b. Data b => b -> b) -> TZTime -> TZTime
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZTime)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZTime)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZTime)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZTime)
dataTypeOf :: TZTime -> DataType
$cdataTypeOf :: TZTime -> DataType
toConstr :: TZTime -> Constr
$ctoConstr :: TZTime -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZTime
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZTime
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZTime -> c TZTime
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZTime -> c TZTime
Data, (forall x. TZTime -> Rep TZTime x)
-> (forall x. Rep TZTime x -> TZTime) -> Generic TZTime
forall x. Rep TZTime x -> TZTime
forall x. TZTime -> Rep TZTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TZTime x -> TZTime
$cfrom :: forall x. TZTime -> Rep TZTime x
Generic)
  deriving anyclass TZTime -> ()
(TZTime -> ()) -> NFData TZTime
forall a. (a -> ()) -> NFData a
rnf :: TZTime -> ()
$crnf :: TZTime -> ()
NFData

{- |
@yyyy-mm-dd hh:mm:ss[.sss] ±hh:mm [time zone]@.
Example: @2022-03-04 02:02:01 +01:00 [Europe/Rome]@.
-}
instance Show TZTime where
  show :: TZTime -> String
show (UnsafeTZTime LocalTime
lt TZInfo
tzi TimeZone
offset) =
    LocalTime -> String
forall a. Show a => a -> String
show LocalTime
lt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TimeZone -> String
forall t. ISO8601 t => t -> String
iso8601Show TimeZone
offset String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
tzIdent String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
    where
      tzIdent :: String
tzIdent = TZIdentifier -> String
T.unpack (TZIdentifier -> String) -> TZIdentifier -> String
forall a b. (a -> b) -> a -> b
$ TZInfo -> TZIdentifier
tziIdentifier TZInfo
tzi

-- | The local time of this `TZTime`.
tzTimeLocalTime :: TZTime -> LocalTime
tzTimeLocalTime :: TZTime -> LocalTime
tzTimeLocalTime = TZTime -> LocalTime
tztLocalTime

-- | The time zone of this `TZTime`.
tzTimeTZInfo :: TZTime -> TZInfo
tzTimeTZInfo :: TZTime -> TZInfo
tzTimeTZInfo = TZTime -> TZInfo
tztTZInfo

-- | The offset observed in this time zone at this moment in time.
tzTimeOffset :: TZTime -> TimeZone
tzTimeOffset :: TZTime -> TimeZone
tzTimeOffset = TZTime -> TimeZone
tztOffset

----------------------------------------------------------------------------
-- Constructors
----------------------------------------------------------------------------

-- | Converts a `UTCTime` to the given time zone.
fromUTC :: TZInfo -> UTCTime -> TZTime
fromUTC :: TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi UTCTime
utct =
  UnsafeTZTime :: LocalTime -> TZInfo -> TimeZone -> TZTime
UnsafeTZTime
    { tztLocalTime :: LocalTime
tztLocalTime = TZ -> UTCTime -> LocalTime
TZ.utcToLocalTimeTZ (TZInfo -> TZ
tziRules TZInfo
tzi) UTCTime
utct
    , tztTZInfo :: TZInfo
tztTZInfo = TZInfo
tzi
    , tztOffset :: TimeZone
tztOffset = TZ -> UTCTime -> TimeZone
TZ.timeZoneForUTCTime (TZInfo -> TZ
tziRules TZInfo
tzi) UTCTime
utct
    }

-- | Converts a `POSIXTime` to the given time zone.
fromPOSIXTime :: TZInfo -> POSIXTime -> TZTime
fromPOSIXTime :: TZInfo -> POSIXTime -> TZTime
fromPOSIXTime TZInfo
tzi = TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi (UTCTime -> TZTime)
-> (POSIXTime -> UTCTime) -> POSIXTime -> TZTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime

-- | Converts a `ZonedTime` to UTC and then to the given time zone.
fromZonedTime :: TZInfo -> ZonedTime -> TZTime
fromZonedTime :: TZInfo -> ZonedTime -> TZTime
fromZonedTime TZInfo
tzi = TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi (UTCTime -> TZTime)
-> (ZonedTime -> UTCTime) -> ZonedTime -> TZTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
zonedTimeToUTC

-- | Attempted to construct a `TZTime` from an invalid or ambiguous `LocalTime`.
data TZError
  = TZOverlap
      LocalTime
      -- ^ The `LocalTime` is ambiguous.
      -- This usually happens when the clocks are set back in
      -- autumn and a local time happens twice.
      ~TZTime -- ^ The first occurrence of the given `LocalTime`, at the earliest offset.
      ~TZTime -- ^ The second occurrence of the given `LocalTime`, at the latest offset.
  | TZGap
      LocalTime
      -- ^ The `LocalTime` is invalid.
      -- This usually happens when the clocks are set forward in
      -- spring and a local time is skipped.
      ~TZTime -- ^ The given `LocalTime` adjusted back by the length of the gap.
      ~TZTime -- ^ The given `LocalTime` adjusted forward by the length of the gap.
  deriving stock (TZError -> TZError -> Bool
(TZError -> TZError -> Bool)
-> (TZError -> TZError -> Bool) -> Eq TZError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TZError -> TZError -> Bool
$c/= :: TZError -> TZError -> Bool
== :: TZError -> TZError -> Bool
$c== :: TZError -> TZError -> Bool
Eq, Typeable TZError
Typeable TZError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TZError -> c TZError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TZError)
-> (TZError -> Constr)
-> (TZError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TZError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZError))
-> ((forall b. Data b => b -> b) -> TZError -> TZError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TZError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TZError -> r)
-> (forall u. (forall d. Data d => d -> u) -> TZError -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TZError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TZError -> m TZError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TZError -> m TZError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TZError -> m TZError)
-> Data TZError
TZError -> DataType
TZError -> Constr
(forall b. Data b => b -> b) -> TZError -> TZError
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) -> TZError -> u
forall u. (forall d. Data d => d -> u) -> TZError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TZError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TZError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZError -> m TZError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZError -> m TZError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZError -> c TZError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZError)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZError -> m TZError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZError -> m TZError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZError -> m TZError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TZError -> m TZError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZError -> m TZError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TZError -> m TZError
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TZError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TZError -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TZError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TZError -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TZError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TZError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TZError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TZError -> r
gmapT :: (forall b. Data b => b -> b) -> TZError -> TZError
$cgmapT :: (forall b. Data b => b -> b) -> TZError -> TZError
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TZError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TZError)
dataTypeOf :: TZError -> DataType
$cdataTypeOf :: TZError -> DataType
toConstr :: TZError -> Constr
$ctoConstr :: TZError -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TZError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZError -> c TZError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TZError -> c TZError
Data, (forall x. TZError -> Rep TZError x)
-> (forall x. Rep TZError x -> TZError) -> Generic TZError
forall x. Rep TZError x -> TZError
forall x. TZError -> Rep TZError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TZError x -> TZError
$cfrom :: forall x. TZError -> Rep TZError x
Generic)
  deriving anyclass (TZError -> ()
(TZError -> ()) -> NFData TZError
forall a. (a -> ()) -> NFData a
rnf :: TZError -> ()
$crnf :: TZError -> ()
NFData)

instance Show TZError where
  show :: TZError -> String
show = TZError -> String
forall e. Exception e => e -> String
displayException

instance Exception TZError where
  displayException :: TZError -> String
displayException = \case
    TZGap LocalTime
lt TZTime
tzt1 TZTime
_ ->
      String
"The local time "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> LocalTime -> String
forall a. Show a => a -> String
show LocalTime
lt
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is invalid in the time zone "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TZIdentifier -> String
forall a. Show a => a -> String
show (TZInfo -> TZIdentifier
tziIdentifier (TZInfo -> TZIdentifier) -> TZInfo -> TZIdentifier
forall a b. (a -> b) -> a -> b
$ TZTime -> TZInfo
tztTZInfo TZTime
tzt1)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."
    TZOverlap LocalTime
lt TZTime
tzt1 TZTime
tzt2 ->
      String
"The local time "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> LocalTime -> String
forall a. Show a => a -> String
show LocalTime
lt
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is ambiguous in the time zone "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TZIdentifier -> String
forall a. Show a => a -> String
show (TZInfo -> TZIdentifier
tziIdentifier (TZInfo -> TZIdentifier) -> TZInfo -> TZIdentifier
forall a b. (a -> b) -> a -> b
$ TZTime -> TZInfo
tztTZInfo TZTime
tzt1)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": it is observed at the offsets "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TimeZone -> String
forall t. ISO8601 t => t -> String
iso8601Show (TZTime -> TimeZone
tzTimeOffset TZTime
tzt1)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and "
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TimeZone -> String
forall t. ISO8601 t => t -> String
iso8601Show (TZTime -> TimeZone
tzTimeOffset TZTime
tzt2)
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"."

-- | Similar to `fromLocalTime`, but returns a `TZError`
-- if the local time is ambiguous/invalid.
fromLocalTimeStrict :: MonadError TZError m => TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict :: forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict TZInfo
tzi LocalTime
lt =
  case TZ -> LocalTime -> LocalToUTCResult
TZ.localTimeToUTCFull (TZInfo -> TZ
tziRules TZInfo
tzi) LocalTime
lt of
    LTUUnique UTCTime
_utc TimeZone
namedOffset ->
      TZTime -> m TZTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TZTime -> m TZTime) -> TZTime -> m TZTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TZInfo -> TimeZone -> TZTime
UnsafeTZTime LocalTime
lt TZInfo
tzi TimeZone
namedOffset
    LTUAmbiguous UTCTime
_utc1 UTCTime
_utc2 TimeZone
namedOffset1 TimeZone
namedOffset2 ->
      TZError -> m TZTime
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TZError -> m TZTime) -> TZError -> m TZTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TZTime -> TZTime -> TZError
TZOverlap LocalTime
lt
        (LocalTime -> TZInfo -> TimeZone -> TZTime
UnsafeTZTime LocalTime
lt TZInfo
tzi TimeZone
namedOffset1)
        (LocalTime -> TZInfo -> TimeZone -> TZTime
UnsafeTZTime LocalTime
lt TZInfo
tzi TimeZone
namedOffset2)
    -- Note: LTUNone means the given `LocalTime` is invalid and lands on a "gap".
    -- The constructor contains:
    -- 1. The `UTCTime` corresponding to the `LocalTime` shifted forward by the duration of the gap.
    --    E.g., if it's a 1-hour gap, this will be the same as "toUTC (localTime + 1 hour)"
    -- 2. The offset observed in that time zone before the clocks changed.
    --
    -- From these 2 pieces of information, we can figure out the rest.
    --
    -- This approach works but is inefficient.
    -- TODO: reimplement parts of `localTimeToUTCFull` to make this more efficient.
    LTUNone UTCTime
utcAfter TimeZone
offsetBefore ->
      let
        offsetAfter :: TimeZone
offsetAfter = TZ -> UTCTime -> TimeZone
TZ.timeZoneForUTCTime (TZInfo -> TZ
tziRules TZInfo
tzi) UTCTime
utcAfter
        gap :: POSIXTime
gap = Pico -> POSIXTime
secondsToNominalDiffTime (Pico -> POSIXTime) -> Pico -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Pico
60 Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
*
          forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Pico (TimeZone -> Int
timeZoneMinutes TimeZone
offsetAfter Int -> Int -> Int
forall a. Num a => a -> a -> a
- TimeZone -> Int
timeZoneMinutes TimeZone
offsetBefore)
        utcBefore :: UTCTime
utcBefore = POSIXTime -> UTCTime -> UTCTime
addUTCTime (- POSIXTime
gap) UTCTime
utcAfter
      in
        TZError -> m TZTime
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TZError -> m TZTime) -> TZError -> m TZTime
forall a b. (a -> b) -> a -> b
$ LocalTime -> TZTime -> TZTime -> TZError
TZGap LocalTime
lt
          (LocalTime -> TZInfo -> TimeZone -> TZTime
UnsafeTZTime (TZ -> UTCTime -> LocalTime
TZ.utcToLocalTimeTZ (TZInfo -> TZ
tziRules TZInfo
tzi) UTCTime
utcBefore) TZInfo
tzi TimeZone
offsetBefore)
          (LocalTime -> TZInfo -> TimeZone -> TZTime
UnsafeTZTime (TZ -> UTCTime -> LocalTime
TZ.utcToLocalTimeTZ (TZInfo -> TZ
tziRules TZInfo
tzi) UTCTime
utcAfter) TZInfo
tzi TimeZone
offsetAfter)

-- | Constructs a `TZTime` from a local time in the given time zone.
--
-- * If the local time lands on a "gap" (e.g. when the clocks are set forward in spring and a local time is skipped),
--   we shift the time forward by the duration of the gap.
-- * If it lands on an "overlap" (e.g. when the clocks are set back in autumn and a local time happens twice),
--   we use the earliest offset.
fromLocalTime :: TZInfo -> LocalTime -> TZTime
fromLocalTime :: TZInfo -> LocalTime -> TZTime
fromLocalTime TZInfo
tzi LocalTime
lt =
  case TZInfo -> LocalTime -> Either TZError TZTime
forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict TZInfo
tzi LocalTime
lt of
    Right TZTime
tzt -> TZTime
tzt
    Left (TZGap LocalTime
_ TZTime
_ TZTime
after) -> TZTime
after
    Left (TZOverlap LocalTime
_ TZTime
atEarliestOffset TZTime
_) -> TZTime
atEarliestOffset

-- | Similar to `fromLocalTime`, but throws a `TZError` in `MonadThrow`
-- if the local time is ambiguous/invalid.
fromLocalTimeThrow :: MonadThrow m => TZInfo -> LocalTime -> m TZTime
fromLocalTimeThrow :: forall (m :: * -> *).
MonadThrow m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeThrow TZInfo
tzi =
  (TZError -> m TZTime)
-> (TZTime -> m TZTime) -> Either TZError TZTime -> m TZTime
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TZError -> m TZTime
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM TZTime -> m TZTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either TZError TZTime -> m TZTime)
-> (LocalTime -> Either TZError TZTime) -> LocalTime -> m TZTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZInfo -> LocalTime -> Either TZError TZTime
forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict TZInfo
tzi

-- | Similar to `fromLocalTime`, but throws an `error`
-- if the local time is ambiguous/invalid.
unsafeFromLocalTime :: HasCallStack => TZInfo -> LocalTime -> TZTime
unsafeFromLocalTime :: HasCallStack => TZInfo -> LocalTime -> TZTime
unsafeFromLocalTime TZInfo
tzi LocalTime
lt =
  case TZInfo -> LocalTime -> Either TZError TZTime
forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict TZInfo
tzi LocalTime
lt of
    Right TZTime
tzt -> TZTime
tzt
    Left TZError
err -> String -> TZTime
forall a. HasCallStack => String -> a
error (String -> TZTime) -> String -> TZTime
forall a b. (a -> b) -> a -> b
$ String
"unsafeFromLocalTime: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TZError -> String
forall e. Exception e => e -> String
displayException TZError
err

----------------------------------------------------------------------------
-- Conversions
----------------------------------------------------------------------------

-- | Converts this moment in time to the universal time-line.
toUTC :: TZTime -> UTCTime
toUTC :: TZTime -> UTCTime
toUTC TZTime
tzt =
  TimeZone -> LocalTime -> UTCTime
localTimeToUTC (TZTime -> TimeZone
tzTimeOffset TZTime
tzt) (TZTime -> LocalTime
tzTimeLocalTime TZTime
tzt)

-- | Converts this moment in time to a POSIX timestamp.
toPOSIXTime :: TZTime -> POSIXTime
toPOSIXTime :: TZTime -> POSIXTime
toPOSIXTime = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime)
-> (TZTime -> UTCTime) -> TZTime -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZTime -> UTCTime
toUTC

-- | Converts this moment in time to a `ZonedTime` (discarding time zone rules).
toZonedTime :: TZTime -> ZonedTime
toZonedTime :: TZTime -> ZonedTime
toZonedTime TZTime
tzt = LocalTime -> TimeZone -> ZonedTime
ZonedTime (TZTime -> LocalTime
tzTimeLocalTime TZTime
tzt) (TZTime -> TimeZone
tzTimeOffset TZTime
tzt)

-- | Converts this moment in time to some other time zone.
inTZ :: TZInfo -> TZTime -> TZTime
inTZ :: TZInfo -> TZTime -> TZTime
inTZ TZInfo
tzi = TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi (UTCTime -> TZTime) -> (TZTime -> UTCTime) -> TZTime -> TZTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZTime -> UTCTime
toUTC

----------------------------------------------------------------------------
-- Modifying a TZTime
----------------------------------------------------------------------------

-- | Modify this moment in time along the universal time-line.
modifyUniversalTimeLine :: (UTCTime -> UTCTime) -> TZTime -> TZTime
modifyUniversalTimeLine :: (UTCTime -> UTCTime) -> TZTime -> TZTime
modifyUniversalTimeLine UTCTime -> UTCTime
f TZTime
tzt =
  TZInfo -> UTCTime -> TZTime
fromUTC (TZTime -> TZInfo
tzTimeTZInfo TZTime
tzt) (UTCTime -> TZTime) -> (TZTime -> UTCTime) -> TZTime -> TZTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTime
f (UTCTime -> UTCTime) -> (TZTime -> UTCTime) -> TZTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZTime -> UTCTime
toUTC (TZTime -> TZTime) -> TZTime -> TZTime
forall a b. (a -> b) -> a -> b
$ TZTime
tzt

-- | Modify this moment in time along the local time-line.
modifyLocalTimeLine :: MonadError TZError m => (LocalTime -> LocalTime) -> TZTime -> m TZTime
modifyLocalTimeLine :: forall (m :: * -> *).
MonadError TZError m =>
(LocalTime -> LocalTime) -> TZTime -> m TZTime
modifyLocalTimeLine LocalTime -> LocalTime
f TZTime
tzt =
  TZInfo -> LocalTime -> m TZTime
forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict (TZTime -> TZInfo
tzTimeTZInfo TZTime
tzt) (LocalTime -> m TZTime)
-> (TZTime -> LocalTime) -> TZTime -> m TZTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> LocalTime
f (LocalTime -> LocalTime)
-> (TZTime -> LocalTime) -> TZTime -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZTime -> LocalTime
tzTimeLocalTime (TZTime -> m TZTime) -> TZTime -> m TZTime
forall a b. (a -> b) -> a -> b
$ TZTime
tzt

----------------------------------------------------------------------------
-- Parsing
----------------------------------------------------------------------------

{- |
@yyyy-mm-dd hh:mm:ss[.sss] [±hh:mm] [time zone]@.
Example: @2022-03-04 02:02:01 +01:00 [Europe/Rome]@.

The offset is optional, except when the local time is ambiguous
(i.e. when the clocks are set forward around that time in that time zone).

The offset can also be expressed using [military time zone abbreviations](https://www.timeanddate.com/time/zones/military),
and these time zones abbreviations as per RFC 822 section 5:
\"UTC\", \"UT\", \"GMT\", \"EST\", \"EDT\", \"CST\", \"CDT\", \"MST\", \"MDT\", \"PST\", \"PDT\".

Note: the time zone's rules are loaded from the embedded database using `fromIdentifier`.
-}
instance Read TZTime where
  readsPrec :: Int -> ReadS TZTime
readsPrec Int
_ String
input = do
    ((LocalTime
lt, Maybe TimeZone
offsetMaybe, TZIdentifier
ident), String
input) <- ReadP (LocalTime, Maybe TimeZone, TZIdentifier)
-> ReadS (LocalTime, Maybe TimeZone, TZIdentifier)
forall a. ReadP a -> ReadS a
P.readP_to_S ReadP (LocalTime, Maybe TimeZone, TZIdentifier)
readComponentsP String
input
    case LocalTime -> TZIdentifier -> Maybe (NonEmpty TZTime)
forall (m :: * -> *).
MonadFail m =>
LocalTime -> TZIdentifier -> m (NonEmpty TZTime)
getValidTZTimes LocalTime
lt TZIdentifier
ident Maybe (NonEmpty TZTime)
-> (NonEmpty TZTime -> Maybe (NonEmpty TZTime))
-> Maybe (NonEmpty TZTime)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe TimeZone -> NonEmpty TZTime -> Maybe (NonEmpty TZTime)
forall (m :: * -> *).
MonadFail m =>
Maybe TimeZone -> NonEmpty TZTime -> m (NonEmpty TZTime)
checkOffset Maybe TimeZone
offsetMaybe of
      Maybe (NonEmpty TZTime)
Nothing -> []
      Just (TZTime
tzt :| []) -> [(TZTime
tzt, String
input)]
      Just (NonEmpty TZTime
tzts) -> NonEmpty TZTime -> [TZTime]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty TZTime
tzts [TZTime] -> (TZTime -> (TZTime, String)) -> [(TZTime, String)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \TZTime
tzt -> (TZTime
tzt, String
input)

readComponentsP :: ReadP (LocalTime, Maybe Time.TimeZone, TZIdentifier)
readComponentsP :: ReadP (LocalTime, Maybe TimeZone, TZIdentifier)
readComponentsP =
  (,,)
    (LocalTime
 -> Maybe TimeZone
 -> TZIdentifier
 -> (LocalTime, Maybe TimeZone, TZIdentifier))
-> ReadP LocalTime
-> ReadP
     (Maybe TimeZone
      -> TZIdentifier -> (LocalTime, Maybe TimeZone, TZIdentifier))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReadS LocalTime -> ReadP LocalTime
forall a. ReadS a -> ReadP a
P.readS_to_P (ReadS LocalTime -> ReadP LocalTime)
-> ReadS LocalTime -> ReadP LocalTime
forall a b. (a -> b) -> a -> b
$ forall a. Read a => ReadS a
reads @LocalTime)
    ReadP
  (Maybe TimeZone
   -> TZIdentifier -> (LocalTime, Maybe TimeZone, TZIdentifier))
-> ReadP (Maybe TimeZone)
-> ReadP
     (TZIdentifier -> (LocalTime, Maybe TimeZone, TZIdentifier))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadP TimeZone -> ReadP (Maybe TimeZone)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadP TimeZone -> ReadP (Maybe TimeZone))
-> ReadP TimeZone -> ReadP (Maybe TimeZone)
forall a b. (a -> b) -> a -> b
$ ReadS TimeZone -> ReadP TimeZone
forall a. ReadS a -> ReadP a
P.readS_to_P (ReadS TimeZone -> ReadP TimeZone)
-> ReadS TimeZone -> ReadP TimeZone
forall a b. (a -> b) -> a -> b
$ forall a. Read a => ReadS a
reads @Time.TimeZone)
    ReadP (TZIdentifier -> (LocalTime, Maybe TimeZone, TZIdentifier))
-> ReadP TZIdentifier
-> ReadP (LocalTime, Maybe TimeZone, TZIdentifier)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP TZIdentifier
readTZIdentP

readTZIdentP :: ReadP TZIdentifier
readTZIdentP :: ReadP TZIdentifier
readTZIdentP = do
  ReadP ()
P.skipSpaces
  ReadP Char -> ReadP ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReadP Char -> ReadP ()) -> ReadP Char -> ReadP ()
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'['
  forall a. IsString a => String -> a
fromString @TZIdentifier (String -> TZIdentifier) -> ReadP String -> ReadP TZIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Char -> ReadP Char -> ReadP String
forall a end. ReadP a -> ReadP end -> ReadP [a]
P.manyTill ReadP Char
P.get (Char -> ReadP Char
P.char Char
']')

-- | Try to construct a `TZTime` from the given components.
getValidTZTimes :: MonadFail m => LocalTime -> TZIdentifier -> m (NonEmpty TZTime)
getValidTZTimes :: forall (m :: * -> *).
MonadFail m =>
LocalTime -> TZIdentifier -> m (NonEmpty TZTime)
getValidTZTimes LocalTime
lt TZIdentifier
ident = do
  TZInfo
tzi <- case TZIdentifier -> Maybe TZInfo
fromIdentifier TZIdentifier
ident of
    Maybe TZInfo
Nothing -> String -> m TZInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m TZInfo) -> String -> m TZInfo
forall a b. (a -> b) -> a -> b
$ String
"Unknown time zone: '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TZIdentifier -> String
T.unpack TZIdentifier
ident String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
    Just TZInfo
tzi -> TZInfo -> m TZInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure TZInfo
tzi
  case TZInfo -> LocalTime -> Either TZError TZTime
forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict TZInfo
tzi LocalTime
lt of
    Right TZTime
tzt -> NonEmpty TZTime -> m (NonEmpty TZTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty TZTime -> m (NonEmpty TZTime))
-> NonEmpty TZTime -> m (NonEmpty TZTime)
forall a b. (a -> b) -> a -> b
$ TZTime
tzt TZTime -> [TZTime] -> NonEmpty TZTime
forall a. a -> [a] -> NonEmpty a
:| []
    Left (TZOverlap LocalTime
_ TZTime
tzt1 TZTime
tzt2) -> NonEmpty TZTime -> m (NonEmpty TZTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NonEmpty TZTime -> m (NonEmpty TZTime))
-> NonEmpty TZTime -> m (NonEmpty TZTime)
forall a b. (a -> b) -> a -> b
$ TZTime
tzt1 TZTime -> [TZTime] -> NonEmpty TZTime
forall a. a -> [a] -> NonEmpty a
:| [TZTime
tzt2]
    Left (TZGap LocalTime
_ TZTime
tzt1 TZTime
tzt2) ->
      String -> m (NonEmpty TZTime)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (NonEmpty TZTime)) -> String -> m (NonEmpty TZTime)
forall a b. (a -> b) -> a -> b
$ String
"Invalid time: the clocks are set forward around this time.\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NonEmpty TZTime -> String
mkSuggestions (TZTime
tzt1 TZTime -> [TZTime] -> NonEmpty TZTime
forall a. a -> [a] -> NonEmpty a
:| [TZTime
tzt2])

-- | If the user specified an offset, check that it matches at least one of the valid `TZTime`s.
checkOffset :: MonadFail m => Maybe Time.TimeZone -> NonEmpty TZTime -> m (NonEmpty TZTime)
checkOffset :: forall (m :: * -> *).
MonadFail m =>
Maybe TimeZone -> NonEmpty TZTime -> m (NonEmpty TZTime)
checkOffset Maybe TimeZone
offsetMaybe NonEmpty TZTime
tzts =
  case Maybe TimeZone
offsetMaybe of
    Maybe TimeZone
Nothing -> NonEmpty TZTime -> m (NonEmpty TZTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty TZTime
tzts
    Just TimeZone
offset ->
      NonEmpty TZTime
tzts
        NonEmpty TZTime -> (NonEmpty TZTime -> [TZTime]) -> [TZTime]
forall a b. a -> (a -> b) -> b
& (TZTime -> Bool) -> NonEmpty TZTime -> [TZTime]
forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (\TZTime
tzt -> TimeZone -> Int
timeZoneMinutes TimeZone
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== TimeZone -> Int
timeZoneMinutes (TZTime -> TimeZone
tzTimeOffset TZTime
tzt))
        [TZTime]
-> ([TZTime] -> Maybe (NonEmpty TZTime)) -> Maybe (NonEmpty TZTime)
forall a b. a -> (a -> b) -> b
& [TZTime] -> Maybe (NonEmpty TZTime)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
        Maybe (NonEmpty TZTime)
-> (Maybe (NonEmpty TZTime) -> m (NonEmpty TZTime))
-> m (NonEmpty TZTime)
forall a b. a -> (a -> b) -> b
& \case
            Just NonEmpty TZTime
validTzts -> NonEmpty TZTime -> m (NonEmpty TZTime)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty TZTime
validTzts
            Maybe (NonEmpty TZTime)
Nothing -> String -> m (NonEmpty TZTime)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (NonEmpty TZTime)) -> String -> m (NonEmpty TZTime)
forall a b. (a -> b) -> a -> b
$ String
"Invalid offset: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TimeZone -> String
forall t. ISO8601 t => t -> String
iso8601Show TimeZone
offset String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> NonEmpty TZTime -> String
mkSuggestions NonEmpty TZTime
tzts

mkSuggestions :: NonEmpty TZTime -> String
mkSuggestions :: NonEmpty TZTime -> String
mkSuggestions NonEmpty TZTime
tzts =
  String
"      Did you mean any of the following?" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (TZTime -> String) -> NonEmpty TZTime -> String
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\TZTime
tzt -> String
"\n      - " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TZTime -> String
forall a. Show a => a -> String
show TZTime
tzt) NonEmpty TZTime
tzts

----------------------------------------------------------------------------
-- Template Haskell
----------------------------------------------------------------------------

readP_to_Q :: String -> ReadP a -> Q a
readP_to_Q :: forall a. String -> ReadP a -> Q a
readP_to_Q String
input ReadP a
parser =
  case ReadP a -> ReadS a
forall a. ReadP a -> ReadS a
P.readP_to_S (ReadP a
parser ReadP a -> ReadP () -> ReadP a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
P.eof) String
input of
    [] -> String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q a) -> String -> Q a
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse: '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
input String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"
    [(a
res, String
_)] -> a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
    [(a, String)]
_ -> String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q a) -> String -> Q a
forall a b. (a -> b) -> a -> b
$ String
"Parsing is ambiguous: '" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
input String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"'"

#if MIN_VERSION_template_haskell(2,17,0)
liftTZTime :: Quote m => TZTime -> Code m TZTime
liftLocalTime :: Quote m => LocalTime -> Code m LocalTime
liftTimeZone :: Quote m => Time.TimeZone -> Code m Time.TimeZone
#else
liftTZTime :: TZTime -> Q (TExp TZTime)
liftTimeZone :: Time.TimeZone -> Q (TExp Time.TimeZone)
liftLocalTime :: LocalTime -> Q (TExp LocalTime)
#endif

-- | NOTE: this assumes the time zone identifier used to construct `TZTime` exists in the
-- embedded time zone database, i.e. it can be loaded using `fromIdentifier`.
liftTZTime :: forall (m :: * -> *). Quote m => TZTime -> Code m TZTime
liftTZTime TZTime
tzt =
  [e||
    UnsafeTZTime
      $$(liftLocalTime $ tzTimeLocalTime tzt)
      (fromJust $ fromIdentifier $$(liftTyped ident))
      $$(liftTimeZone $ tzTimeOffset tzt)
  ||]
  where
    ident :: TZIdentifier
ident = TZInfo -> TZIdentifier
tziIdentifier (TZInfo -> TZIdentifier) -> TZInfo -> TZIdentifier
forall a b. (a -> b) -> a -> b
$ TZTime -> TZInfo
tzTimeTZInfo TZTime
tzt

liftLocalTime :: forall (m :: * -> *). Quote m => LocalTime -> Code m LocalTime
liftLocalTime (LocalTime (YearMonthDay Year
yy Int
mm Int
dd) (TimeOfDay Int
hh Int
mmm (MkFixed Year
ss))) =
  [e||
    LocalTime
      (YearMonthDay $$(liftTyped yy) $$(liftTyped mm) $$(liftTyped dd))
      (TimeOfDay $$(liftTyped hh) $$(liftTyped mmm) (MkFixed $$(liftTyped ss)))
  ||]

liftTimeZone :: forall (m :: * -> *). Quote m => TimeZone -> Code m TimeZone
liftTimeZone (TimeZone Int
tzMins Bool
tzSummer String
tzName) =
  [e|| TimeZone $$(liftTyped tzMins) $$(liftTyped tzSummer) $$(liftTyped tzName) ||]