module Language.Fluent.Time where

import Data.Char (toLower)
import Data.List.Extra (enumerate)
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. (Enum a, Bounded a) => [a]
enumerate, (Char -> Char) -> ShowS
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) -> ShowS
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 -> ShowS
[TimeOptions] -> ShowS
TimeOptions -> String
(Int -> TimeOptions -> ShowS)
-> (TimeOptions -> String)
-> ([TimeOptions] -> ShowS)
-> Show TimeOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeOptions -> ShowS
showsPrec :: Int -> TimeOptions -> ShowS
$cshow :: TimeOptions -> String
show :: TimeOptions -> String
$cshowList :: [TimeOptions] -> ShowS
showList :: [TimeOptions] -> ShowS
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