module Language.Fluent.Time where

import Data.Char (toLower)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Language.Fluent.Width (Width (..))
import Language.Fluent.Width qualified as Width
import Prelude

-- | How many digits a date or time field takes, e.g. the ninth month is
-- @9@ when 'Numeric' and @09@ when 'TwoDigit'.
data Digits = Numeric | TwoDigit
    deriving stock (Digits -> Digits -> Bool
(Digits -> Digits -> Bool)
-> (Digits -> Digits -> Bool) -> Eq Digits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Digits -> Digits -> Bool
== :: Digits -> Digits -> Bool
$c/= :: Digits -> Digits -> Bool
/= :: Digits -> Digits -> Bool
Eq, Digits
Digits -> Digits -> Bounded Digits
forall a. a -> a -> Bounded a
$cminBound :: Digits
minBound :: Digits
$cmaxBound :: Digits
maxBound :: Digits
Bounded, Int -> Digits
Digits -> Int
Digits -> [Digits]
Digits -> Digits
Digits -> Digits -> [Digits]
Digits -> Digits -> Digits -> [Digits]
(Digits -> Digits)
-> (Digits -> Digits)
-> (Int -> Digits)
-> (Digits -> Int)
-> (Digits -> [Digits])
-> (Digits -> Digits -> [Digits])
-> (Digits -> Digits -> [Digits])
-> (Digits -> Digits -> Digits -> [Digits])
-> Enum Digits
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Digits -> Digits
succ :: Digits -> Digits
$cpred :: Digits -> Digits
pred :: Digits -> Digits
$ctoEnum :: Int -> Digits
toEnum :: Int -> Digits
$cfromEnum :: Digits -> Int
fromEnum :: Digits -> Int
$cenumFrom :: Digits -> [Digits]
enumFrom :: Digits -> [Digits]
$cenumFromThen :: Digits -> Digits -> [Digits]
enumFromThen :: Digits -> Digits -> [Digits]
$cenumFromTo :: Digits -> Digits -> [Digits]
enumFromTo :: Digits -> Digits -> [Digits]
$cenumFromThenTo :: Digits -> Digits -> Digits -> [Digits]
enumFromThenTo :: Digits -> Digits -> Digits -> [Digits]
Enum)

instance Show Digits where
    show :: Digits -> String
show Digits
Numeric = String
"numeric"
    show Digits
TwoDigit = String
"2-digit"

instance Read Digits where
    readsPrec :: Int -> ReadS Digits
readsPrec Int
_ String
s = [(Digits
it, String
"") | Digits
it <- [Digits
forall a. Bounded a => a
minBound .. Digits
forall a. Bounded a => a
maxBound], (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower (Digits -> String
forall a. Show a => a -> String
show Digits
it) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower String
s]

-- | <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/DateTimeFormat/DateTimeFormat>
data TimeOptions = TimeOptions
    { TimeOptions -> Text
timeZone :: Text
    , TimeOptions -> Maybe Bool
hour12 :: Maybe Bool
    , TimeOptions -> Maybe Width
weekday :: Maybe Width
    , TimeOptions -> Maybe Width
era :: Maybe Width
    , TimeOptions -> Maybe Digits
year :: Maybe Digits
    , TimeOptions -> Maybe (Either Digits Width)
month :: Maybe (Either Digits Width)
    , TimeOptions -> Maybe Digits
day :: Maybe Digits
    , TimeOptions -> Maybe Digits
hour :: Maybe Digits
    , TimeOptions -> Maybe Digits
minute :: Maybe Digits
    , TimeOptions -> Maybe Digits
second :: Maybe Digits
    , TimeOptions -> Maybe Width
timeZoneName :: Maybe Width
    }
    deriving stock (TimeOptions -> TimeOptions -> Bool
(TimeOptions -> TimeOptions -> Bool)
-> (TimeOptions -> TimeOptions -> Bool) -> Eq TimeOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeOptions -> TimeOptions -> Bool
== :: TimeOptions -> TimeOptions -> Bool
$c/= :: TimeOptions -> TimeOptions -> Bool
/= :: TimeOptions -> TimeOptions -> Bool
Eq, Int -> TimeOptions -> String -> String
[TimeOptions] -> String -> String
TimeOptions -> String
(Int -> TimeOptions -> String -> String)
-> (TimeOptions -> String)
-> ([TimeOptions] -> String -> String)
-> Show TimeOptions
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TimeOptions -> String -> String
showsPrec :: Int -> TimeOptions -> String -> String
$cshow :: TimeOptions -> String
show :: TimeOptions -> String
$cshowList :: [TimeOptions] -> String -> String
showList :: [TimeOptions] -> String -> String
Show)

timeOptions :: TimeOptions
timeOptions :: TimeOptions
timeOptions =
    TimeOptions
        { timeZone :: Text
timeZone = Text
"UTC"
        , hour12 :: Maybe Bool
hour12 = Maybe Bool
forall a. Maybe a
Nothing
        , weekday :: Maybe Width
weekday = Maybe Width
forall a. Maybe a
Nothing
        , era :: Maybe Width
era = Maybe Width
forall a. Maybe a
Nothing
        , year :: Maybe Digits
year = Maybe Digits
forall a. Maybe a
Nothing
        , month :: Maybe (Either Digits Width)
month = Maybe (Either Digits Width)
forall a. Maybe a
Nothing
        , day :: Maybe Digits
day = Maybe Digits
forall a. Maybe a
Nothing
        , hour :: Maybe Digits
hour = Maybe Digits
forall a. Maybe a
Nothing
        , minute :: Maybe Digits
minute = Maybe Digits
forall a. Maybe a
Nothing
        , second :: Maybe Digits
second = Maybe Digits
forall a. Maybe a
Nothing
        , timeZoneName :: Maybe Width
timeZoneName = Maybe Width
forall a. Maybe a
Nothing
        }

fields :: TimeOptions -> [(Char, Either Digits Width)]
fields :: TimeOptions -> [(Char, Either Digits Width)]
fields TimeOptions
options
    | [(Char, Either Digits Width)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Char, Either Digits Width)]
asked =
        TimeOptions -> [(Char, Either Digits Width)]
fields
            TimeOptions
options
                { year = Just Numeric
                , month = Just $ Left Numeric
                , day = Just Numeric
                }
    | Bool
otherwise = [(Char, Either Digits Width)]
asked
  where
    asked :: [(Char, Either Digits Width)]
asked =
        ((Char, Maybe (Either Digits Width))
 -> Maybe (Char, Either Digits Width))
-> [(Char, Maybe (Either Digits Width))]
-> [(Char, Either Digits Width)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
            (Char, Maybe (Either Digits Width))
-> Maybe (Char, Either Digits Width)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => (Char, m a) -> m (Char, a)
sequence
            [ (Char
'G', Width -> Either Digits Width
forall a b. b -> Either a b
Right (Width -> Either Digits Width)
-> Maybe Width -> Maybe (Either Digits Width)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOptions
options.era)
            , (Char
'y', Digits -> Either Digits Width
forall a b. a -> Either a b
Left (Digits -> Either Digits Width)
-> Maybe Digits -> Maybe (Either Digits Width)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOptions
options.year)
            , (Char
'M', TimeOptions
options.month)
            , (Char
'd', Digits -> Either Digits Width
forall a b. a -> Either a b
Left (Digits -> Either Digits Width)
-> Maybe Digits -> Maybe (Either Digits Width)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOptions
options.day)
            , (Char
'E', Width -> Either Digits Width
forall a b. b -> Either a b
Right (Width -> Either Digits Width)
-> Maybe Width -> Maybe (Either Digits Width)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOptions
options.weekday)
            , (Char
hourSymbol, Digits -> Either Digits Width
forall a b. a -> Either a b
Left (Digits -> Either Digits Width)
-> Maybe Digits -> Maybe (Either Digits Width)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOptions
options.hour)
            , (Char
'm', Digits -> Either Digits Width
forall a b. a -> Either a b
Left (Digits -> Either Digits Width)
-> Maybe Digits -> Maybe (Either Digits Width)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOptions
options.minute)
            , (Char
's', Digits -> Either Digits Width
forall a b. a -> Either a b
Left (Digits -> Either Digits Width)
-> Maybe Digits -> Maybe (Either Digits Width)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOptions
options.second)
            , (Char
'z', Width -> Either Digits Width
forall a b. b -> Either a b
Right (Width -> Either Digits Width)
-> (Width -> Width) -> Width -> Either Digits Width
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Width -> Width
zoneWidth (Width -> Either Digits Width)
-> Maybe Width -> Maybe (Either Digits Width)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TimeOptions
options.timeZoneName)
            ]
    zoneWidth :: Width -> Width
zoneWidth Width
Narrow = Width
Short
    zoneWidth Width
it = Width
it

    hourSymbol :: Char
    hourSymbol :: Char
hourSymbol = case TimeOptions
options.hour12 of
        Maybe Bool
Nothing -> Char
'j'
        Just Bool
True -> Char
'h'
        Just Bool
False -> Char
'H'

skeleton :: TimeOptions -> Text
skeleton :: TimeOptions -> Text
skeleton = String -> Text
Text.pack (String -> Text) -> (TimeOptions -> String) -> TimeOptions -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char, Either Digits Width) -> String)
-> [(Char, Either Digits Width)] -> String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Char, Either Digits Width) -> String
symbol ([(Char, Either Digits Width)] -> String)
-> (TimeOptions -> [(Char, Either Digits Width)])
-> TimeOptions
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeOptions -> [(Char, Either Digits Width)]
fields
  where
    symbol :: (Char, Either Digits Width) -> String
    symbol :: (Char, Either Digits Width) -> String
symbol (Char
s, Either Digits Width
written) = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Either Digits Width -> Int
letters Either Digits Width
written) Char
s

letters :: Either Digits Width -> Int
letters :: Either Digits Width -> Int
letters = (Digits -> Int) -> (Width -> Int) -> Either Digits Width -> Int
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Digits -> Int
digitsLetters Width -> Int
Width.letters
  where
    digitsLetters :: Digits -> Int
    digitsLetters :: Digits -> Int
digitsLetters Digits
Numeric = Int
1
    digitsLetters Digits
TwoDigit = Int
2