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

{-# LANGUAGE CPP #-}

module Data.Time.TZTime.QQ
  ( tz
  ) where

import Data.List.NonEmpty (NonEmpty(..))
import Data.Time.TZTime.Internal as I
import Language.Haskell.TH (Exp, Q)
import Language.Haskell.TH.Quote
import Text.ParserCombinators.ReadP qualified as P

#if MIN_VERSION_template_haskell(2,17,0)
import Language.Haskell.TH.Syntax (unTypeCode)
#else
import Language.Haskell.TH.Syntax (unType)
#endif

{- |
Quasiquoter for parsing a `TZTime` at compile-time in the format:
@yyyy-mm-dd hh:mm:ss[.sss] [±hh:mm] [time zone]@.

The offset is optional, except when the local time is ambiguous
(i.e. when the clocks are set back 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 `Data.Time.TZInfo.fromIdentifier`.

>>> [tz|2022-03-04 10:15:40.123 [Europe/Rome]|]
2022-03-04 10:15:40.123 +01:00 [Europe/Rome]

>>> [tz|2022-11-06 01:30:00 [America/Winnipeg]|]
...
    • Ambiguous time: please specify an offset.
      Did you mean any of the following?
      - 2022-11-06 01:30:00 -05:00 [America/Winnipeg]
      - 2022-11-06 01:30:00 -06:00 [America/Winnipeg]
...

-}
tz :: QuasiQuoter
tz :: QuasiQuoter
tz = QuasiQuoter
  { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
qexp
  , quotePat :: String -> Q Pat
quotePat = \String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot use 'tz' as a pattern."
  , quoteType :: String -> Q Type
quoteType = \String
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot use 'tz' as a type."
  , quoteDec :: String -> Q [Dec]
quoteDec = \String
_ ->forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot use 'tz' as a declaration."
  }
  where
    qexp :: String -> Q Exp
    qexp :: String -> Q Exp
qexp String
input = do
      (LocalTime
lt, Maybe TimeZone
offsetMaybe, TZIdentifier
ident) <- forall a. String -> ReadP a -> Q a
I.readP_to_Q String
input (ReadP (LocalTime, Maybe TimeZone, TZIdentifier)
I.readComponentsP forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP ()
P.skipSpaces)
      forall (m :: * -> *).
MonadFail m =>
LocalTime -> TZIdentifier -> m (NonEmpty TZTime)
I.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)
I.checkOffset Maybe TimeZone
offsetMaybe forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        TZTime
tzt :| [] -> TZTime -> Q Exp
toExp TZTime
tzt
        NonEmpty TZTime
tzts -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Ambiguous time: please specify an offset.\n" forall a. Semigroup a => a -> a -> a
<> NonEmpty TZTime -> String
I.mkSuggestions NonEmpty TZTime
tzts

    toExp :: TZTime -> Q Exp
    toExp :: TZTime -> Q Exp
toExp TZTime
tzt =
#if MIN_VERSION_template_haskell(2,17,0)
      forall a (m :: * -> *). Quote m => Code m a -> m Exp
unTypeCode forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Quote m => TZTime -> Code m TZTime
I.liftTZTime TZTime
tzt
#else
      unType <$> I.liftTZTime tzt
#endif