-- | @since 0.1
module Kairos.Types.TZInput
  ( TZInput (..),
    parseTZInput,
    locale,
    _TZDatabase,
    _TZActual,
  )
where

import Control.Applicative (asum)
import Control.DeepSeq (NFData)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (TimeZone, parseTimeM)
import Data.Time.Format (TimeLocale)
import Data.Time.Format qualified as Format
import Data.Time.LocalTime qualified as LT
import Data.Time.Zones.All (TZLabel)
import GHC.Generics (Generic)
import Kairos.Internal qualified as Internal
import Optics.Core (Prism', prism)

-- | Timezone input.
data TZInput
  = -- | TZ database label like America/New_York.
    TZDatabase TZLabel
  | -- | Actual timezone.
    TZActual TimeZone
  deriving stock
    ( -- | @since 0.1
      TZInput -> TZInput -> Bool
(TZInput -> TZInput -> Bool)
-> (TZInput -> TZInput -> Bool) -> Eq TZInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TZInput -> TZInput -> Bool
== :: TZInput -> TZInput -> Bool
$c/= :: TZInput -> TZInput -> Bool
/= :: TZInput -> TZInput -> Bool
Eq,
      -- | @since 0.1
      (forall x. TZInput -> Rep TZInput x)
-> (forall x. Rep TZInput x -> TZInput) -> Generic TZInput
forall x. Rep TZInput x -> TZInput
forall x. TZInput -> Rep TZInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TZInput -> Rep TZInput x
from :: forall x. TZInput -> Rep TZInput x
$cto :: forall x. Rep TZInput x -> TZInput
to :: forall x. Rep TZInput x -> TZInput
Generic,
      -- | @since 0.1
      Int -> TZInput -> ShowS
[TZInput] -> ShowS
TZInput -> String
(Int -> TZInput -> ShowS)
-> (TZInput -> String) -> ([TZInput] -> ShowS) -> Show TZInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TZInput -> ShowS
showsPrec :: Int -> TZInput -> ShowS
$cshow :: TZInput -> String
show :: TZInput -> String
$cshowList :: [TZInput] -> ShowS
showList :: [TZInput] -> ShowS
Show
    )
  deriving anyclass
    ( -- | @since 0.1
      TZInput -> ()
(TZInput -> ()) -> NFData TZInput
forall a. (a -> ()) -> NFData a
$crnf :: TZInput -> ()
rnf :: TZInput -> ()
NFData
    )

-- | Attempts to parse 'TZInput'.
--
-- @since 0.1
parseTZInput :: Text -> Maybe TZInput
parseTZInput :: Text -> Maybe TZInput
parseTZInput Text
txt = [Maybe TZInput] -> Maybe TZInput
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe TZInput]
parsers
  where
    parsers :: [Maybe TZInput]
parsers =
      ((Text -> Maybe TZInput) -> Text -> Maybe TZInput
forall a b. (a -> b) -> a -> b
$ Text
txt)
        ((Text -> Maybe TZInput) -> Maybe TZInput)
-> [Text -> Maybe TZInput] -> [Maybe TZInput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ Text -> Maybe TZInput
parseTZLabel,
              String -> Text -> Maybe TZInput
parseTZOffset String
"%z",
              String -> Text -> Maybe TZInput
parseTZOffset String
"%:z",
              Text -> Maybe TZInput
parseTZOffsetH,
              Text -> Maybe TZInput
utcAbbrev
            ]

parseTZLabel :: Text -> Maybe TZInput
parseTZLabel :: Text -> Maybe TZInput
parseTZLabel = (TZLabel -> TZInput) -> Maybe TZLabel -> Maybe TZInput
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TZLabel -> TZInput
TZDatabase (Maybe TZLabel -> Maybe TZInput)
-> (Text -> Maybe TZLabel) -> Text -> Maybe TZInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe TZLabel
Internal.tzNameToTZLabel

parseTZOffset :: String -> Text -> Maybe TZInput
parseTZOffset :: String -> Text -> Maybe TZInput
parseTZOffset String
fmt = (TimeZone -> TZInput) -> Maybe TimeZone -> Maybe TZInput
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TimeZone -> TZInput
TZActual (Maybe TimeZone -> Maybe TZInput)
-> (Text -> Maybe TimeZone) -> Text -> Maybe TZInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> Maybe TimeZone
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
False TimeLocale
locale String
fmt (String -> Maybe TimeZone)
-> (Text -> String) -> Text -> Maybe TimeZone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

parseTZOffsetH :: Text -> Maybe TZInput
parseTZOffsetH :: Text -> Maybe TZInput
parseTZOffsetH Text
txt =
  -- +/- and HH e.g. +13
  if Text -> Int
T.length Text
txt Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
    then String -> Text -> Maybe TZInput
parseTZOffset String
"%z" (Text
txt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"00")
    else Maybe TZInput
forall a. Maybe a
Nothing

utcAbbrev :: Text -> Maybe TZInput
utcAbbrev :: Text -> Maybe TZInput
utcAbbrev Text
"Z" = TZInput -> Maybe TZInput
forall a. a -> Maybe a
Just (TZInput -> Maybe TZInput) -> TZInput -> Maybe TZInput
forall a b. (a -> b) -> a -> b
$ TimeZone -> TZInput
TZActual TimeZone
LT.utc
utcAbbrev Text
_ = Maybe TZInput
forall a. Maybe a
Nothing

-- | Default locale.
--
-- @since 0.1
locale :: TimeLocale
locale :: TimeLocale
locale = TimeLocale
Format.defaultTimeLocale

-- | @since 0.1
_TZDatabase :: Prism' TZInput TZLabel
_TZDatabase :: Prism' TZInput TZLabel
_TZDatabase =
  (TZLabel -> TZInput)
-> (TZInput -> Either TZInput TZLabel) -> Prism' TZInput TZLabel
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    TZLabel -> TZInput
TZDatabase
    ( \case
        TZDatabase TZLabel
lbl -> TZLabel -> Either TZInput TZLabel
forall a b. b -> Either a b
Right TZLabel
lbl
        TZInput
other -> TZInput -> Either TZInput TZLabel
forall a b. a -> Either a b
Left TZInput
other
    )
{-# INLINE _TZDatabase #-}

-- | @since 0.1
_TZActual :: Prism' TZInput TimeZone
_TZActual :: Prism' TZInput TimeZone
_TZActual =
  (TimeZone -> TZInput)
-> (TZInput -> Either TZInput TimeZone) -> Prism' TZInput TimeZone
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
    TimeZone -> TZInput
TZActual
    ( \case
        TZActual TimeZone
t -> TimeZone -> Either TZInput TimeZone
forall a b. b -> Either a b
Right TimeZone
t
        TZInput
other -> TZInput -> Either TZInput TimeZone
forall a b. a -> Either a b
Left TZInput
other
    )
{-# INLINE _TZActual #-}