Time.hs

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 (Eq, Bounded, Enum)

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

instance Read Digits where
    readsPrec _ s = [(it, "") | it <- enumerate, fmap toLower (show it) == fmap toLower s]

-- | <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/DateTimeFormat/DateTimeFormat>
data TimeOptions = TimeOptions
    { timeZone :: Text
    , hour12 :: Maybe Bool
    , weekday :: Maybe Width
    , era :: Maybe Width
    , year :: Maybe Digits
    , month :: Maybe (Either Digits Width)
    , day :: Maybe Digits
    , hour :: Maybe Digits
    , minute :: Maybe Digits
    , second :: Maybe Digits
    , timeZoneName :: Maybe Width
    }
    deriving stock (Eq, Show)

timeOptions :: TimeOptions
timeOptions =
    TimeOptions
        { timeZone = "UTC"
        , hour12 = Nothing
        , weekday = Nothing
        , era = Nothing
        , year = Nothing
        , month = Nothing
        , day = Nothing
        , hour = Nothing
        , minute = Nothing
        , second = Nothing
        , timeZoneName = Nothing
        }

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

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

skeleton :: TimeOptions -> Text
skeleton = Text.pack . foldMap symbol . fields
  where
    symbol :: (Char, Either Digits Width) -> String
    symbol (s, written) = replicate (letters written) s

letters :: Either Digits Width -> Int
letters = either digitsLetters Width.letters
  where
    digitsLetters :: Digits -> Int
    digitsLetters Numeric = 1
    digitsLetters TwoDigit = 2