{-# 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) #-}
data TZTime = UnsafeTZTime
{ TZTime -> LocalTime
tztLocalTime :: LocalTime
, TZTime -> TZInfo
tztTZInfo :: TZInfo
, TZTime -> TimeZone
tztOffset :: Time.TimeZone
}
deriving stock (TZTime -> TZTime -> Bool
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: TZTime -> ()
$crnf :: TZTime -> ()
NFData
instance Show TZTime where
show :: TZTime -> String
show (UnsafeTZTime LocalTime
lt TZInfo
tzi TimeZone
offset) =
forall a. Show a => a -> String
show LocalTime
lt forall a. Semigroup a => a -> a -> a
<> String
" " forall a. Semigroup a => a -> a -> a
<> forall t. ISO8601 t => t -> String
iso8601Show TimeZone
offset forall a. Semigroup a => a -> a -> a
<> String
" [" forall a. Semigroup a => a -> a -> a
<> String
tzIdent forall a. Semigroup a => a -> a -> a
<> String
"]"
where
tzIdent :: String
tzIdent = TZIdentifier -> String
T.unpack forall a b. (a -> b) -> a -> b
$ TZInfo -> TZIdentifier
tziIdentifier TZInfo
tzi
tzTimeLocalTime :: TZTime -> LocalTime
tzTimeLocalTime :: TZTime -> LocalTime
tzTimeLocalTime = TZTime -> LocalTime
tztLocalTime
tzTimeTZInfo :: TZTime -> TZInfo
tzTimeTZInfo :: TZTime -> TZInfo
tzTimeTZInfo = TZTime -> TZInfo
tztTZInfo
tzTimeOffset :: TZTime -> TimeZone
tzTimeOffset :: TZTime -> TimeZone
tzTimeOffset = TZTime -> TimeZone
tztOffset
fromUTC :: TZInfo -> UTCTime -> TZTime
fromUTC :: TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi UTCTime
utct =
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
}
fromPOSIXTime :: TZInfo -> POSIXTime -> TZTime
fromPOSIXTime :: TZInfo -> POSIXTime -> TZTime
fromPOSIXTime TZInfo
tzi = TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime
fromZonedTime :: TZInfo -> ZonedTime -> TZTime
fromZonedTime :: TZInfo -> ZonedTime -> TZTime
fromZonedTime TZInfo
tzi = TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
zonedTimeToUTC
data TZError
= TZOverlap
LocalTime
~TZTime
~TZTime
| TZGap
LocalTime
~TZTime
~TZTime
deriving stock (TZError -> TZError -> Bool
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: TZError -> ()
$crnf :: TZError -> ()
NFData)
instance Show TZError where
show :: TZError -> String
show = 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 "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show LocalTime
lt
forall a. Semigroup a => a -> a -> a
<> String
" is invalid in the time zone "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (TZInfo -> TZIdentifier
tziIdentifier forall a b. (a -> b) -> a -> b
$ TZTime -> TZInfo
tztTZInfo TZTime
tzt1)
forall a. Semigroup a => a -> a -> a
<> String
"."
TZOverlap LocalTime
lt TZTime
tzt1 TZTime
tzt2 ->
String
"The local time "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show LocalTime
lt
forall a. Semigroup a => a -> a -> a
<> String
" is ambiguous in the time zone "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (TZInfo -> TZIdentifier
tziIdentifier forall a b. (a -> b) -> a -> b
$ TZTime -> TZInfo
tztTZInfo TZTime
tzt1)
forall a. Semigroup a => a -> a -> a
<> String
": it is observed at the offsets "
forall a. Semigroup a => a -> a -> a
<> forall t. ISO8601 t => t -> String
iso8601Show (TZTime -> TimeZone
tzTimeOffset TZTime
tzt1)
forall a. Semigroup a => a -> a -> a
<> String
" and "
forall a. Semigroup a => a -> a -> a
<> forall t. ISO8601 t => t -> String
iso8601Show (TZTime -> TimeZone
tzTimeOffset TZTime
tzt2)
forall a. Semigroup a => a -> a -> a
<> String
"."
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 ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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)
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 forall a b. (a -> b) -> a -> b
$ Pico
60 forall a. Num a => a -> a -> a
*
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Pico (TimeZone -> Int
timeZoneMinutes TimeZone
offsetAfter forall a. Num a => a -> a -> a
- TimeZone -> Int
timeZoneMinutes TimeZone
offsetBefore)
utcBefore :: UTCTime
utcBefore = POSIXTime -> UTCTime -> UTCTime
addUTCTime (- POSIXTime
gap) UTCTime
utcAfter
in
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError 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)
fromLocalTime :: TZInfo -> LocalTime -> TZTime
fromLocalTime :: TZInfo -> LocalTime -> TZTime
fromLocalTime TZInfo
tzi LocalTime
lt =
case 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
fromLocalTimeThrow :: MonadThrow m => TZInfo -> LocalTime -> m TZTime
fromLocalTimeThrow :: forall (m :: * -> *).
MonadThrow m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeThrow TZInfo
tzi =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict TZInfo
tzi
unsafeFromLocalTime :: HasCallStack => TZInfo -> LocalTime -> TZTime
unsafeFromLocalTime :: HasCallStack => TZInfo -> LocalTime -> TZTime
unsafeFromLocalTime TZInfo
tzi LocalTime
lt =
case forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict TZInfo
tzi LocalTime
lt of
Right TZTime
tzt -> TZTime
tzt
Left TZError
err -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"unsafeFromLocalTime: " forall a. Semigroup a => a -> a -> a
<> forall e. Exception e => e -> String
displayException TZError
err
toUTC :: TZTime -> UTCTime
toUTC :: TZTime -> UTCTime
toUTC TZTime
tzt =
TimeZone -> LocalTime -> UTCTime
localTimeToUTC (TZTime -> TimeZone
tzTimeOffset TZTime
tzt) (TZTime -> LocalTime
tzTimeLocalTime TZTime
tzt)
toPOSIXTime :: TZTime -> POSIXTime
toPOSIXTime :: TZTime -> POSIXTime
toPOSIXTime = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZTime -> UTCTime
toUTC
toZonedTime :: TZTime -> ZonedTime
toZonedTime :: TZTime -> ZonedTime
toZonedTime TZTime
tzt = LocalTime -> TimeZone -> ZonedTime
ZonedTime (TZTime -> LocalTime
tzTimeLocalTime TZTime
tzt) (TZTime -> TimeZone
tzTimeOffset TZTime
tzt)
inTZ :: TZInfo -> TZTime -> TZTime
inTZ :: TZInfo -> TZTime -> TZTime
inTZ TZInfo
tzi = TZInfo -> UTCTime -> TZTime
fromUTC TZInfo
tzi forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZTime -> UTCTime
toUTC
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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UTCTime
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZTime -> UTCTime
toUTC forall a b. (a -> b) -> a -> b
$ TZTime
tzt
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 =
forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict (TZTime -> TZInfo
tzTimeTZInfo TZTime
tzt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> LocalTime
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. TZTime -> LocalTime
tzTimeLocalTime forall a b. (a -> b) -> a -> b
$ TZTime
tzt
instance Read TZTime where
readsPrec :: Int -> ReadS TZTime
readsPrec Int
_ String
input = do
((LocalTime
lt, Maybe TimeZone
offsetMaybe, TZIdentifier
ident), String
input) <- forall a. ReadP a -> ReadS a
P.readP_to_S ReadP (LocalTime, Maybe TimeZone, TZIdentifier)
readComponentsP String
input
case forall (m :: * -> *).
MonadFail m =>
LocalTime -> TZIdentifier -> m (NonEmpty TZTime)
getValidTZTimes LocalTime
lt TZIdentifier
ident forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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) -> forall a. NonEmpty a -> [a]
NE.toList NonEmpty TZTime
tzts 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 =
(,,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. ReadS a -> ReadP a
P.readS_to_P forall a b. (a -> b) -> a -> b
$ forall a. Read a => ReadS a
reads @LocalTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall a. ReadS a -> ReadP a
P.readS_to_P forall a b. (a -> b) -> a -> b
$ forall a. Read a => ReadS a
reads @Time.TimeZone)
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
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
'['
forall a. IsString a => String -> a
fromString @TZIdentifier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a end. ReadP a -> ReadP end -> ReadP [a]
P.manyTill ReadP Char
P.get (Char -> ReadP Char
P.char Char
']')
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 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown time zone: '" forall a. Semigroup a => a -> a -> a
<> TZIdentifier -> String
T.unpack TZIdentifier
ident forall a. Semigroup a => a -> a -> a
<> String
"'"
Just TZInfo
tzi -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TZInfo
tzi
case forall (m :: * -> *).
MonadError TZError m =>
TZInfo -> LocalTime -> m TZTime
fromLocalTimeStrict TZInfo
tzi LocalTime
lt of
Right TZTime
tzt -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TZTime
tzt forall a. a -> [a] -> NonEmpty a
:| []
Left (TZOverlap LocalTime
_ TZTime
tzt1 TZTime
tzt2) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TZTime
tzt1 forall a. a -> [a] -> NonEmpty a
:| [TZTime
tzt2]
Left (TZGap LocalTime
_ TZTime
tzt1 TZTime
tzt2) ->
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid time: the clocks are set forward around this time.\n" forall a. Semigroup a => a -> a -> a
<> NonEmpty TZTime -> String
mkSuggestions (TZTime
tzt1 forall a. a -> [a] -> NonEmpty a
:| [TZTime
tzt2])
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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty TZTime
tzts
Just TimeZone
offset ->
NonEmpty TZTime
tzts
forall a b. a -> (a -> b) -> b
& forall a. (a -> Bool) -> NonEmpty a -> [a]
NE.filter (\TZTime
tzt -> TimeZone -> Int
timeZoneMinutes TimeZone
offset forall a. Eq a => a -> a -> Bool
== TimeZone -> Int
timeZoneMinutes (TZTime -> TimeZone
tzTimeOffset TZTime
tzt))
forall a b. a -> (a -> b) -> b
& forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
forall a b. a -> (a -> b) -> b
& \case
Just NonEmpty TZTime
validTzts -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty TZTime
validTzts
Maybe (NonEmpty TZTime)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid offset: " forall a. Semigroup a => a -> a -> a
<> forall t. ISO8601 t => t -> String
iso8601Show TimeZone
offset forall a. Semigroup a => a -> a -> a
<> String
"\n" 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?" forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\TZTime
tzt -> String
"\n - " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TZTime
tzt) NonEmpty TZTime
tzts
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 forall a. ReadP a -> ReadS a
P.readP_to_S (ReadP a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
P.eof) String
input of
[] -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to parse: '" forall a. Semigroup a => a -> a -> a
<> String
input forall a. Semigroup a => a -> a -> a
<> String
"'"
[(a
res, String
_)] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res
[(a, String)]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Parsing is ambiguous: '" forall a. Semigroup a => a -> a -> a
<> String
input 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
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 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) ||]