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 (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
Eq, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> String
show :: Style -> String
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
Show)

-- | How a 'Currency' is displayed.
data CurrencyDisplay
    = -- | @€12.50@
      Symbol
    | -- | @EUR 12.50@
      Code
    | -- | @12.50 euros@
      Name
    deriving stock (CurrencyDisplay -> CurrencyDisplay -> Bool
(CurrencyDisplay -> CurrencyDisplay -> Bool)
-> (CurrencyDisplay -> CurrencyDisplay -> Bool)
-> Eq CurrencyDisplay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CurrencyDisplay -> CurrencyDisplay -> Bool
== :: CurrencyDisplay -> CurrencyDisplay -> Bool
$c/= :: CurrencyDisplay -> CurrencyDisplay -> Bool
/= :: CurrencyDisplay -> CurrencyDisplay -> Bool
Eq, Int -> CurrencyDisplay -> ShowS
[CurrencyDisplay] -> ShowS
CurrencyDisplay -> String
(Int -> CurrencyDisplay -> ShowS)
-> (CurrencyDisplay -> String)
-> ([CurrencyDisplay] -> ShowS)
-> Show CurrencyDisplay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CurrencyDisplay -> ShowS
showsPrec :: Int -> CurrencyDisplay -> ShowS
$cshow :: CurrencyDisplay -> String
show :: CurrencyDisplay -> String
$cshowList :: [CurrencyDisplay] -> ShowS
showList :: [CurrencyDisplay] -> ShowS
Show, CurrencyDisplay
CurrencyDisplay -> CurrencyDisplay -> Bounded CurrencyDisplay
forall a. a -> a -> Bounded a
$cminBound :: CurrencyDisplay
minBound :: CurrencyDisplay
$cmaxBound :: CurrencyDisplay
maxBound :: CurrencyDisplay
Bounded, Int -> CurrencyDisplay
CurrencyDisplay -> Int
CurrencyDisplay -> [CurrencyDisplay]
CurrencyDisplay -> CurrencyDisplay
CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay]
CurrencyDisplay
-> CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay]
(CurrencyDisplay -> CurrencyDisplay)
-> (CurrencyDisplay -> CurrencyDisplay)
-> (Int -> CurrencyDisplay)
-> (CurrencyDisplay -> Int)
-> (CurrencyDisplay -> [CurrencyDisplay])
-> (CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay])
-> (CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay])
-> (CurrencyDisplay
    -> CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay])
-> Enum CurrencyDisplay
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 :: CurrencyDisplay -> CurrencyDisplay
succ :: CurrencyDisplay -> CurrencyDisplay
$cpred :: CurrencyDisplay -> CurrencyDisplay
pred :: CurrencyDisplay -> CurrencyDisplay
$ctoEnum :: Int -> CurrencyDisplay
toEnum :: Int -> CurrencyDisplay
$cfromEnum :: CurrencyDisplay -> Int
fromEnum :: CurrencyDisplay -> Int
$cenumFrom :: CurrencyDisplay -> [CurrencyDisplay]
enumFrom :: CurrencyDisplay -> [CurrencyDisplay]
$cenumFromThen :: CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay]
enumFromThen :: CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay]
$cenumFromTo :: CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay]
enumFromTo :: CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay]
$cenumFromThenTo :: CurrencyDisplay
-> CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay]
enumFromThenTo :: CurrencyDisplay
-> CurrencyDisplay -> CurrencyDisplay -> [CurrencyDisplay]
Enum)

instance Read CurrencyDisplay where
    readsPrec :: Int -> ReadS CurrencyDisplay
readsPrec Int
_ String
s = [(CurrencyDisplay
it, String
"") | CurrencyDisplay
it <- [CurrencyDisplay
forall a. Bounded a => a
minBound .. CurrencyDisplay
forall a. Bounded a => a
maxBound], (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 (CurrencyDisplay -> String
forall a. Show a => a -> String
show CurrencyDisplay
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/NumberFormat/NumberFormat>
data NumberOptions = NumberOptions
    { NumberOptions -> Form
form :: Plural.Form
    , NumberOptions -> Style
style :: Style
    , NumberOptions -> CurrencyDisplay
currencyDisplay :: CurrencyDisplay
    , NumberOptions -> Width
unitDisplay :: Width
    , NumberOptions -> Bool
useGrouping :: Bool
    , NumberOptions -> Int
minimumIntegerDigits :: Int
    , NumberOptions -> Int
minimumFractionDigits :: Int
    , NumberOptions -> Maybe Int
maximumFractionDigits :: Maybe Int
    , NumberOptions -> Maybe Int
minimumSignificantDigits :: Maybe Int
    , NumberOptions -> Maybe Int
maximumSignificantDigits :: Maybe Int
    }
    deriving stock (NumberOptions -> NumberOptions -> Bool
(NumberOptions -> NumberOptions -> Bool)
-> (NumberOptions -> NumberOptions -> Bool) -> Eq NumberOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NumberOptions -> NumberOptions -> Bool
== :: NumberOptions -> NumberOptions -> Bool
$c/= :: NumberOptions -> NumberOptions -> Bool
/= :: NumberOptions -> NumberOptions -> Bool
Eq, Int -> NumberOptions -> ShowS
[NumberOptions] -> ShowS
NumberOptions -> String
(Int -> NumberOptions -> ShowS)
-> (NumberOptions -> String)
-> ([NumberOptions] -> ShowS)
-> Show NumberOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NumberOptions -> ShowS
showsPrec :: Int -> NumberOptions -> ShowS
$cshow :: NumberOptions -> String
show :: NumberOptions -> String
$cshowList :: [NumberOptions] -> ShowS
showList :: [NumberOptions] -> ShowS
Show)

numberOptions :: NumberOptions
numberOptions :: NumberOptions
numberOptions =
    NumberOptions
        { form :: Form
form = Form
Plural.Cardinal
        , style :: Style
style = Style
Decimal
        , currencyDisplay :: CurrencyDisplay
currencyDisplay = CurrencyDisplay
Symbol
        , unitDisplay :: Width
unitDisplay = Width
Short
        , useGrouping :: Bool
useGrouping = Bool
True
        , minimumIntegerDigits :: Int
minimumIntegerDigits = Int
1
        , minimumFractionDigits :: Int
minimumFractionDigits = Int
0
        , maximumFractionDigits :: Maybe Int
maximumFractionDigits = Maybe Int
forall a. Maybe a
Nothing
        , minimumSignificantDigits :: Maybe Int
minimumSignificantDigits = Maybe Int
forall a. Maybe a
Nothing
        , maximumSignificantDigits :: Maybe Int
maximumSignificantDigits = Maybe Int
forall a. Maybe a
Nothing
        }

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

significantDigits :: NumberOptions -> Maybe (Int, Int)
significantDigits :: NumberOptions -> Maybe (Int, Int)
significantDigits NumberOptions
options
    | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust NumberOptions
options.minimumSignificantDigits Bool -> Bool -> Bool
|| Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust NumberOptions
options.maximumSignificantDigits =
        (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
atLeast, Int
atMost)
    | Bool
otherwise = Maybe (Int, Int)
forall a. Maybe a
Nothing
  where
    atLeast :: Int
atLeast = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
1 NumberOptions
options.minimumSignificantDigits
    atMost :: Int
atMost = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
atLeast (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
21 NumberOptions
options.maximumSignificantDigits

unitIdentifier :: Text -> Text
unitIdentifier :: Text -> Text
unitIdentifier = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"litre" Text
"liter" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"metre" Text
"meter" (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
Text.replace Text
"gramme" Text
"gram"

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

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

toLiteral :: Scientific -> NumberOptions -> NumberLiteral
toLiteral :: Scientific -> NumberOptions -> NumberLiteral
toLiteral Scientific
value NumberOptions
options =
    Text -> NumberLiteral
NumberLiteral (Text -> NumberLiteral)
-> (Scientific -> Text) -> Scientific -> NumberLiteral
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (Scientific -> String) -> Scientific -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FPFormat -> Maybe Int -> Scientific -> String
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
digits) (Scientific -> NumberLiteral) -> Scientific -> NumberLiteral
forall a b. (a -> b) -> a -> b
$ Scientific
value
  where
    digits :: Int
digits =
        Int -> Int -> Int
forall a. Ord a => a -> a -> a
max NumberOptions
options.minimumFractionDigits
            (Int -> Int) -> (Scientific -> Int) -> Scientific -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0
            (Int -> Int) -> (Scientific -> Int) -> Scientific -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate
            (Int -> Int) -> (Scientific -> Int) -> Scientific -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Int
base10Exponent
            (Scientific -> Int)
-> (Scientific -> Scientific) -> Scientific -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Scientific
normalize
            (Scientific -> Int) -> Scientific -> Int
forall a b. (a -> b) -> a -> b
$ Scientific
value