Time.hs

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

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

instance Read Digits where
    readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], 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