Number.hs

module Language.Fluent.Number where

import Data.Char (toLower)
import Data.List.Extra (enumerate)
import Data.Maybe (fromMaybe, isJust)
import Data.Ord (clamp)
import Data.Scientific (FPFormat (Fixed), Scientific, base10Exponent, formatScientific, normalize)
import Data.Text (Text)
import Data.Text qualified as Text
import Language.Fluent.AST (NumberLiteral (..))
import Language.Fluent.Plural qualified as Plural
import Language.Fluent.Width (Width (..))
import Prelude

-- | What a number denotes, which determines how it is formatted.
data Style
    = -- | A plain number: @12.5@
      Decimal
    | -- | A ratio, shown as a percentage: @1,250%@
      Percent
    | -- | An amount of the currency with the given
      -- <https://en.wikipedia.org/wiki/ISO_4217 ISO 4217> code: @Currency "EUR"@ gives @€12.50@
      Currency Text
    | -- | A measurement in the given
      -- <https://unicode.org/reports/tr35/tr35-general.html#Unit_Identifiers CLDR unit>:
      -- @Unit "second"@ gives @12.5 s@
      Unit Text
    deriving stock (Eq, Show)

-- | How a 'Currency' is displayed.
data CurrencyDisplay
    = -- | @€12.50@
      Symbol
    | -- | @EUR 12.50@
      Code
    | -- | @12.50 euros@
      Name
    deriving stock (Eq, Show, Bounded, Enum)

instance Read CurrencyDisplay 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/NumberFormat/NumberFormat>
data NumberOptions = NumberOptions
    { form :: Plural.Form
    , style :: Style
    , currencyDisplay :: CurrencyDisplay
    , unitDisplay :: Width
    , useGrouping :: Bool
    , minimumIntegerDigits :: Int
    , minimumFractionDigits :: Int
    , maximumFractionDigits :: Maybe Int
    , minimumSignificantDigits :: Maybe Int
    , maximumSignificantDigits :: Maybe Int
    }
    deriving stock (Eq, Show)

numberOptions :: NumberOptions
numberOptions =
    NumberOptions
        { form = Plural.Cardinal
        , style = Decimal
        , currencyDisplay = Symbol
        , unitDisplay = Short
        , useGrouping = True
        , minimumIntegerDigits = 1
        , minimumFractionDigits = 0
        , maximumFractionDigits = Nothing
        , minimumSignificantDigits = Nothing
        , maximumSignificantDigits = Nothing
        }

-- | The fewest integer digits to show, from 1 to 21.
integerDigits :: NumberOptions -> Int
integerDigits options = clamp (1, 21) options.minimumIntegerDigits

-- | The fewest and most fraction digits to show, each from 0 to 100.
fractionDigits :: NumberOptions -> (Int, Int)
fractionDigits options = (atLeast, atMost)
  where
    atLeast = clamp (0, 100) options.minimumFractionDigits
    atMost = clamp (atLeast, 100) $ fromMaybe 3 options.maximumFractionDigits

-- | The fewest and most significant digits to show, each from 1 to 21, if either is set.
significantDigits :: NumberOptions -> Maybe (Int, Int)
significantDigits options
    | isJust options.minimumSignificantDigits || isJust options.maximumSignificantDigits =
        Just (atLeast, atMost)
    | otherwise = Nothing
  where
    atLeast = clamp (1, 21) $ fromMaybe 1 options.minimumSignificantDigits
    atMost = clamp (atLeast, 21) $ fromMaybe 21 options.maximumSignificantDigits

unitIdentifier :: Text -> Text
unitIdentifier = Text.replace "litre" "liter" . Text.replace "metre" "meter" . Text.replace "gramme" "gram"

-- | <https://unicode-org.github.io/icu/userguide/format_parse/numbers/skeletons.html>
skeleton :: NumberOptions -> Text
skeleton options =
    Text.unwords $
        [style' | not $ Text.null style']
            <> [width | not $ Text.null width]
            <> precision
            <> ["group-off" | not options.useGrouping]
            <> integerWidth
  where
    integerWidth = case integerDigits options of
        1 -> []
        digits -> ["integer-width/+" <> Text.replicate digits "0"]
    style', width :: Text
    style' = case options.style of
        Decimal -> ""
        Percent -> "percent scale/100"
        Currency code -> "currency/" <> code
        Unit unit -> "unit/" <> unitIdentifier unit
    width = case options.style of
        Currency{} -> case options.currencyDisplay of
            Symbol -> "unit-width-short"
            Code -> "unit-width-iso-code"
            Name -> "unit-width-full-name"
        Unit{} -> case options.unitDisplay of
            Short -> "unit-width-short"
            Narrow -> "unit-width-narrow"
            Long -> "unit-width-full-name"
        _ -> ""
    precision
        | Just (atLeast, atMost) <- significantDigits options =
            [Text.replicate atLeast "@" <> Text.replicate (atMost - atLeast) "#"]
        | options.minimumFractionDigits > 0 || isJust options.maximumFractionDigits =
            let (atLeast, atMost) = fractionDigits options
             in ["." <> Text.replicate atLeast "0" <> Text.replicate (atMost - atLeast) "#"]
        | otherwise = []

fromLiteral :: NumberLiteral -> (Scientific, NumberOptions)
fromLiteral (NumberLiteral (Text.unpack -> read -> n)) =
    (n, numberOptions{minimumFractionDigits = max 0 . negate . base10Exponent $ n})

toLiteral :: Scientific -> NumberOptions -> NumberLiteral
toLiteral value options =
    NumberLiteral . Text.pack . formatScientific Fixed (Just digits) $ value
  where
    digits =
        max (fst $ fractionDigits options)
            . max 0
            . negate
            . base10Exponent
            . normalize
            $ value