Number.hs

module Language.Fluent.Number where

import Data.Char (toLower)
import Data.Maybe (fromMaybe, isJust)
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 <- [minBound .. maxBound], 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
        }

fractionDigits :: NumberOptions -> (Int, Int)
fractionDigits options = (atLeast, atMost)
  where
    atLeast = max 0 options.minimumFractionDigits
    atMost = max atLeast $ fromMaybe 3 options.maximumFractionDigits

significantDigits :: NumberOptions -> Maybe (Int, Int)
significantDigits options
    | isJust options.minimumSignificantDigits || isJust options.maximumSignificantDigits =
        Just (atLeast, atMost)
    | otherwise = Nothing
  where
    atLeast = max 0 $ fromMaybe 1 options.minimumSignificantDigits
    atMost = max atLeast $ 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]
            <> [ "integer-width/+" <> Text.replicate options.minimumIntegerDigits "0"
               | options.minimumIntegerDigits > 1
               ]
  where
    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 options.minimumFractionDigits
            . max 0
            . negate
            . base10Exponent
            . normalize
            $ value