fluent 1.0.0 → 1.1.0

raw patch · 25 files changed

+860/−296 lines, 25 filesdep +transformersdep ~basedep ~fluent-syntaxsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: transformers

Dependency ranges changed: base, fluent-syntax

API changes (from Hackage documentation)

Files

• CHANGELOG.md +32/−0
• Setup.hs +0/−2
• fluent.cabal +9/−18
• src/Language/Fluent.hs +12/−10
• src/Language/Fluent/Bundle.hs +74/−58
• src/Language/Fluent/Function.hs +37/−29
• src/Language/Fluent/Locale/English.hs +285/−0
• src/Language/Fluent/Number.hs +18/−9
• src/Language/Fluent/Pattern.hs +21/−51
• src/Language/Fluent/Plural.hs +5/−2
• src/Language/Fluent/Time.hs +2/−1
• src/Language/Fluent/Translate.hs +33/−9
• src/Language/Fluent/Value.hs +97/−37
• src/Language/Fluent/Width.hs +3/−1
• test/ArgumentSpec.hs +11/−1
• test/BuiltinSpec.hs +95/−25
• test/CycleSpec.hs +1/−1
• test/ExpansionSpec.hs +22/−0
• test/FunctionSpec.hs +4/−4
• test/IsolationSpec.hs +17/−0
• test/LiteralSpec.hs +5/−2
• test/Prelude.hs +2/−35
• test/SelectSpec.hs +30/−0
• test/ValueSpec.hs +43/−0
• test/VariableSpec.hs +2/−1

@@ -5,6 +5,38 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [1.1.0] - 2026-10-20++### Added++- `Language.Fluent` re-exports `parseResourceLenient`.+- `ToValue` instances for sized integers, `Natural` and `Float`.+- `Value.fromIntegral` and `Value.fromFloatDigits`.+- `Value.Invalid`, a value that fails to format.+- `Number.integerDigits`.+- A small example English locale in `Language.Fluent.Locale.English`.+- `Language.Fluent` re-exports `Plural.Category`.+- `type` option of `NUMBER`: `"cardinal"` or `"ordinal"`.++### Changed++- **Breaking:** `fluent-syntax` 1.1.0 breaking changes:+  - `parseResource` fails on a syntax error. `parseResourceLenient` returns a `JunkEntry` instead.+  - The `fluent` quasi-quoter and `messageIdentifiers` fail to compile on a syntax error.+- **Breaking:** `SomeValue` is now `Value`, the `Value` class is now `ToValue`, and constructors are used qualified: `Value.String`, `Value.Number`, `Value.Time`.+- **Breaking:** `CustomValue` and `ToValue.format` are replaced by `Value.Formatted`.++### Fixed++- Correct `base` version requirement (requires 4.16).+- `NaN` and infinities fail to format instead of printing nonsense numbers.+- Huge digit options, such as `minimumIntegerDigits: 1000000000`, are capped to the ranges of `Intl.NumberFormat`.+- BiDi isolation additionally applies to number literals, function calls, and select expressions.+- A select expression fails when its selector fails, instead of picking the default variant.+- A string selector no longer matches numeric variant keys by plural category.+- `NUMBER` no longer depends on option order to settle `style`, and a `currency` or `unit` style without a currency or unit fails.+- A message that expands more than 100 placeables fails instead of running for hours.+ ## [1.0.0] - 2026-10-01  ### Added

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: fluent-version: 1.0.0+version: 1.1.0 synopsis: Haskell implementation of Project Fluent description:   This library implements <https://projectfluent.org Project Fluent>,@@ -28,37 +28,24 @@   default-extensions:     ApplicativeDo     BlockArguments-    DataKinds-    DefaultSignatures-    DeriveAnyClass-    DeriveGeneric-    DeriveLift     DerivingStrategies-    DerivingVia-    ExistentialQuantification-    ExplicitNamespaces     FlexibleInstances-    GADTSyntax     GeneralizedNewtypeDeriving     ImportQualifiedPost-    InstanceSigs     LambdaCase     NamedFieldPuns     NoImplicitPrelude-    NumericUnderscores-    OverloadedLabels     OverloadedRecordDot     OverloadedStrings     QuasiQuotes+    RankNTypes     RecordWildCards-    RecursiveDo     ScopedTypeVariables     StrictData     TupleSections     TypeApplications     TypeFamilies     TypeOperators-    TypeSynonymInstances     ViewPatterns    ghc-options:@@ -75,12 +62,13 @@   import: common   hs-source-dirs: src   build-depends:-    base >=4 && <5,+    base >=4.16 && <5,     extra >=1.6 && <1.9,-    fluent-syntax >=1.0 && <1.1,+    fluent-syntax >=1.1 && <1.2,     scientific >=0.3 && <0.4,     text >=2.1.2 && <2.2,     time >=1.12 && <1.17,+    transformers >=0.5 && <0.7,     unordered-containers >=0.2 && <0.3,    exposed-modules:@@ -88,6 +76,7 @@     Language.Fluent.Bundle     Language.Fluent.Function     Language.Fluent.Locale+    Language.Fluent.Locale.English     Language.Fluent.Number     Language.Fluent.Pattern     Language.Fluent.Plural@@ -105,6 +94,7 @@     ArgumentSpec     BuiltinSpec     CycleSpec+    ExpansionSpec     FunctionSpec     IsolationSpec     LiteralSpec@@ -112,13 +102,14 @@     Prelude     ReferenceSpec     SelectSpec+    ValueSpec     VariableSpec    build-depends:     base >=4 && <5,     extra >=1.6 && <1.9,     fluent,-    fluent-syntax >=1.0 && <1.1,+    fluent-syntax >=1.1 && <1.2,     hspec >=2.11 && <2.12,     scientific >=0.3 && <0.4,     text >=2.1.2 && <2.2,

@@ -16,15 +16,17 @@ -- * the 'Bundle' type which combines 'Locale's with parsed 'Resources' -- * the 'Translate' typeclass which translates messages from a 'Bundle' ----- This library does not provide any concrete instances of 'Locale'.--- It is not intended to be used directly for translating messages.------ Applications should instead use a library built on top of this one, such as:+-- This library does not provide any production-ready instances of 'Locale'.+-- Applications should instead use a dedicated backend for full localisation support, such as: ----- * <https://hackage.package.org/package/fluent-icu fluent-icu>,---   backed by <https://hackage.package.org/package/text-icu text-icu>--- * <https://hackage.package.org/package/miso-fluent miso-fluent>,+-- * <https://hackage.haskell.org/package/fluent-icu fluent-icu>,+--   backed by <https://hackage.haskell.org/package/text-icu text-icu>+-- * <https://hackage.haskell.org/package/miso-fluent miso-fluent>, --   backed by the browser's @Intl@ API+--+-- For quick evaluation or basic English translation, this library includes an example+-- 'Language.Fluent.Locale.English' locale. It implements a small subset of English rules and is+-- not a replacement for a full-featured backend. module Language.Fluent     ( module Language.Fluent.AST     , module Language.Fluent.Bundle@@ -50,11 +52,11 @@     , Style (..)     , numberOptions     )-import Language.Fluent.Parser (parseResource)+import Language.Fluent.Parser (parseResource, parseResourceLenient) import Language.Fluent.Pattern (Pattern (..), PatternElement (..))-import Language.Fluent.Plural (Form (..))+import Language.Fluent.Plural (Category (..), Form (..)) import Language.Fluent.TH (fluent, messageIdentifiers) import Language.Fluent.Time (Digits (..), TimeOptions (..), timeOptions) import Language.Fluent.Translate (Reference (..), Translate (..))-import Language.Fluent.Value (CustomValue (..), SomeValue (..), Value (..))+import Language.Fluent.Value (ToValue (..), Value) import Language.Fluent.Width (Width (..))

@@ -4,7 +4,10 @@ module Language.Fluent.Bundle where  import Control.Applicative ((<|>))-import Control.Monad (guard)+import Control.Monad (guard, when)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.State.Strict (StateT)+import Control.Monad.Trans.State.Strict qualified as StateT import Data.Coerce (coerce) import Data.Either (partitionEithers) import Data.Either.Extra (maybeToEither)@@ -30,15 +33,13 @@     ( Pattern (..)     , PatternElement (..)     , attribute-    , interpolates-    , matchesCategory-    , matchesExact     , namedArgument     , termArguments     , variantKey     ) import Language.Fluent.Pattern qualified as Pattern-import Language.Fluent.Value (SomeValue (..))+import Language.Fluent.Value (Value)+import Language.Fluent.Value qualified as Value import Prelude  -- | A collection of Fluent resources and the configuration needed to@@ -52,7 +53,7 @@         :: HashMap             Identifier             ( [Pattern]-              -> HashMap Identifier SomeValue+              -> HashMap Identifier Value               -> Either String Pattern             )     -- ^ Functions available to messages, shadowing the builtins of the same name.@@ -60,14 +61,19 @@     -- ^ Whether to use isolation marks (FSI, PDI) around interpolated values.     } +-- | A change to a 'Bundle'. data Override-    = UseIsolating Bool-    | WithFunction Identifier ([Pattern] -> HashMap Identifier SomeValue -> Either String Pattern)+    = -- | Whether to use isolation marks around placeables.+      UseIsolating Bool+    | -- | Add a function, shadowing the builtin of the same name.+      WithFunction Identifier ([Pattern] -> HashMap Identifier Value -> Either String Pattern) +-- | Apply an 'Override' to a 'Bundle'. override :: Override -> Bundle locale -> Bundle locale override (UseIsolating useIsolating) bundle = bundle{useIsolating} override (WithFunction name f) bundle = bundle{functions = HashMap.insert name f bundle.functions} +-- | The codes of the locales of a bundle. localeCodes :: (Locale locale) => Bundle locale -> NonEmpty Text localeCodes Bundle{locales} = Locale.toCode <$> locales @@ -99,9 +105,11 @@         functions = "functions=" <> Text.show (HashMap.keys bundle.functions)         useIsolating = "useIsolating=" <> Text.show bundle.useIsolating +-- | A bundle of 'Resource's for the given 'Locale's, with the default configuration. bundle :: NonEmpty locale -> [Resource] -> Bundle locale bundle locales resources = Bundle{locales, resources, functions = mempty, useIsolating = True} +-- | The first message of a 'Bundle' with the identifier. message :: Identifier -> Bundle locale -> Maybe AST.Message message id Bundle{resources} = listToMaybe do     Resource{entries} <- resources@@ -109,6 +117,7 @@     guard $ found.id == id     pure found +-- | The first term of a 'Bundle' with the identifier. term :: Identifier -> Bundle locale -> Maybe AST.Term term name Bundle{resources} = listToMaybe do     Resource{entries} <- resources@@ -116,99 +125,105 @@     guard $ found.id == name     pure found +-- | Resolve all the selections and interpolations of an AST 'AST.Pattern' to a simple 'Pattern'. pattern     :: (Locale locale)     => Bundle locale-    -> HashMap Identifier SomeValue+    -> HashMap Identifier Value     -> AST.Pattern     -> Either String Pattern-pattern bundle@Bundle{locales = locale :| _, ..} = resolve mempty+pattern bundle@Bundle{locales = locale :| _, ..} = (flip StateT.evalStateT 0 .) . resolve mempty   where     resolve         :: HashSet Identifier-        -> HashMap Identifier SomeValue+        -> HashMap Identifier Value         -> AST.Pattern-        -> Either String Pattern+        -> StateT Int (Either String) Pattern     resolve followed arguments (AST.Pattern elements) =         sconcat <$> sequence (NonEmpty.zipWith element (True :| repeat False) elements)       where-        element :: Bool -> AST.PatternElement -> Either String Pattern-        element _ (AST.InlineText t) = Right $ Pattern.fromValue t-        element _ (AST.BlockText t) = Right $ Pattern.fromValue t-        element first (AST.Placeable placeable) =-            beginsLine . isolated <$> expression followed arguments expr+        element :: Bool -> AST.PatternElement -> StateT Int (Either String) Pattern+        element _ (AST.InlineText t) = pure $ Pattern.fromValue t+        element _ (AST.BlockText t) = pure $ Pattern.fromValue t+        element first (AST.Placeable placeable) = do+            expanded <- StateT.get+            when (expanded >= 100) . lift $ Left "Too many placeables expanded"+            StateT.put $ expanded + 1+            beginsLine . isolated+                <$> expression followed arguments (AST.placeableExpression placeable)           where-            expr = AST.placeableExpression placeable-            isolated-                | length elements > 1-                , useIsolating-                , interpolates expr =-                    Pattern . pure . Isolated-                | otherwise = id             beginsLine                 | AST.BlockPlaceable{} <- placeable, not first = ("\n" <>)                 | otherwise = id +        isolated+            | length elements > 1, useIsolating = Pattern . pure . Isolated+            | otherwise = id+     expression         :: HashSet Identifier-        -> HashMap Identifier SomeValue+        -> HashMap Identifier Value         -> AST.Expression-        -> Either String Pattern+        -> StateT Int (Either String) Pattern     expression followed arguments (AST.Inline inline) =         inlineExpression followed arguments inline     expression followed arguments (AST.Select (AST.SelectExpression selector variants')) = do         let AST.VariantList variants = variants'-        picked <- case inlineExpression followed arguments selector of-            Left{} -> Right Nothing-            Right (Pattern (Value selected :| [])) ->-                Right $-                    List.find (matchesExact selected . variantKey) variants-                        <|> List.find (matchesCategory locale selected . variantKey) variants-            Right{} -> Left "Selector is not a number or identifier"+        picked <- case selector of+            AST.VariableReference name | not $ name `HashMap.member` arguments -> pure Nothing+            _ -> lift . matching variants =<< inlineExpression followed arguments selector         AST.Variant{value = picked'} <--            maybeToEither "Select expression has no default variant" $+            lift . maybeToEither "Select expression has no default variant" $                 picked <|> List.find AST.isDefault variants         resolve followed arguments picked' +    matching variants (Pattern (Value selected :| [])) =+        Right $+            List.find (Value.matchesExact selected . variantKey) variants+                <|> List.find (Value.matchesCategory locale selected . variantKey) variants+    matching _ _ = Left "Selector is not a number or identifier"+     inlineExpression         :: HashSet Identifier-        -> HashMap Identifier SomeValue+        -> HashMap Identifier Value         -> AST.InlineExpression-        -> Either String Pattern-    inlineExpression _ _ (AST.StringLiteralExpression s) = Right . Pattern.fromValue $ s.value+        -> StateT Int (Either String) Pattern+    inlineExpression _ _ (AST.StringLiteralExpression s) = pure . Pattern.fromValue $ s.value     inlineExpression _ _ (AST.NumberLiteralExpression n) =-        Right . Pattern.fromValue . uncurry NumberValue $ Number.fromLiteral n+        pure . Pattern.fromValue . uncurry Value.Number $ Number.fromLiteral n     inlineExpression followed arguments (AST.PlaceableExpression expr) =         expression followed arguments expr     inlineExpression _ arguments (AST.VariableReference id) =-        Pattern.fromValue-            <$> maybeToEither-                ("Variable not found: " <> show id)-                (HashMap.lookup id arguments)+        lift+            . fmap Pattern.fromValue+            . maybeToEither ("Variable not found: " <> show id)+            $ HashMap.lookup id arguments     inlineExpression followed arguments (AST.FunctionReference id called) = do         let AST.CallArguments args = called         f <--            maybeToEither ("Function not found: " <> show id) $+            lift . maybeToEither ("Function not found: " <> show id) $                 HashMap.lookup id bundle.functions <|> HashMap.lookup id builtins         let (named, positional) = partitionEithers args         positional' <- traverse (inlineExpression followed arguments) positional-        f positional' . HashMap.fromList $ namedArgument <$> named+        lift . f positional' . HashMap.fromList $ namedArgument <$> named     inlineExpression followed arguments (AST.MessageReference id accessor) = do         found <--            maybeToEither ("Message not found: " <> Text.unpack (coerce id)) $ message id bundle-        found' <- case accessor of+            lift . maybeToEither ("Message not found: " <> Text.unpack (coerce id)) $+                message id bundle+        found' <- lift case accessor of             Nothing -> maybeToEither ("Message has no value: " <> show id) found.value             Just (AST.AttributeAccessor it) -> attributeOf id it found.attributes         follow followed arguments (reference (coerce id) accessor) found'     inlineExpression followed _ (AST.TermReference id accessor args) = do-        found <- maybeToEither ("Term not found: " <> show id) $ term id bundle-        found <--            maybe-                (Right found.value)-                (\(AST.AttributeAccessor it) -> attributeOf (withDash id) it found.attributes)-                accessor-        arguments' <- termArguments args-        follow followed arguments' (reference (withDash id) accessor) found+        found <- lift . maybeToEither ("Term not found: " <> show id) $ term id bundle+        found' <-+            lift $+                maybe+                    (Right found.value)+                    (\(AST.AttributeAccessor it) -> attributeOf (withDash id) it found.attributes)+                    accessor+        arguments' <- lift $ termArguments args+        follow followed arguments' (reference (withDash id) accessor) found'      attributeOf         :: Identifier@@ -223,15 +238,16 @@     withDash (Identifier i) = Identifier $ "-" <> i      reference :: Identifier -> Maybe AST.AttributeAccessor -> Identifier-    reference (Identifier name) (Just (AST.AttributeAccessor (Identifier it))) = Identifier $ name <> "." <> it+    reference (Identifier name) (Just (AST.AttributeAccessor (Identifier it))) =+        Identifier $ name <> "." <> it     reference name _ = name      follow         :: HashSet Identifier-        -> HashMap Identifier SomeValue+        -> HashMap Identifier Value         -> Identifier         -> AST.Pattern-        -> Either String Pattern+        -> StateT Int (Either String) Pattern     follow followed arguments name found-        | name `HashSet.member` followed = Left $ "Cyclic reference: " <> show name+        | name `HashSet.member` followed = lift . Left $ "Cyclic reference: " <> show name         | otherwise = resolve (HashSet.insert name followed) arguments found

@@ -8,13 +8,13 @@ import Data.Monoid (Endo (..)) import Data.Text (Text) import Data.Text qualified as Text-import Language.Fluent.AST (Identifier (..), NumberLiteral (..))+import Language.Fluent.AST (Identifier (..)) import Language.Fluent.Number (NumberOptions (..), Style (..))-import Language.Fluent.Number qualified as Number import Language.Fluent.Pattern (Pattern (..), PatternElement (..)) import Language.Fluent.Pattern qualified as Pattern import Language.Fluent.Time (Digits, TimeOptions (..))-import Language.Fluent.Value (SomeValue (..))+import Language.Fluent.Value (Value, asText)+import Language.Fluent.Value qualified as Value import Language.Fluent.Width (Width) import Text.Read (readMaybe) import Prelude@@ -23,32 +23,45 @@     :: HashMap         Identifier         ( [Pattern]-          -> HashMap Identifier SomeValue+          -> HashMap Identifier Value           -> Either String Pattern         ) builtins = HashMap.fromList [(Identifier "NUMBER", number), (Identifier "DATETIME", datetime)]  -- | @NUMBER($ratio, minimumFractionDigits: 2)@-number :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern+number :: [Pattern] -> HashMap Identifier Value -> Either String Pattern number positional args = do     given <- maybeToEither "NUMBER: expected one positional argument" $ lone positional     case given of-        NumberValue value opts -> do+        Value.Number value opts -> do             change <- changes numberOption args-            pure . Pattern.fromValue . NumberValue value $ appEndo change opts+            style <- numberStyle opts.style+            pure . Pattern.fromValue . Value.Number value $ (appEndo change opts){style}+        Value.Invalid reason -> Left reason         _ -> Left "NUMBER: the positional argument is not a number"   where-    numberOption :: Identifier -> SomeValue -> Either String (Endo NumberOptions)+    option name = asText <$> HashMap.lookup (Identifier name) args++    numberStyle :: Style -> Either String Style+    numberStyle current = case (option "style", option "currency", option "unit") of+        (Just "decimal", _, _) -> Right Decimal+        (Just "percent", _, _) -> Right Percent+        (Just "currency", currency, _) ->+            maybe (Left "NUMBER: the currency style needs a currency") (Right . Currency) currency+        (Just "unit", _, unit) ->+            maybe (Left "NUMBER: the unit style needs a unit") (Right . Unit) unit+        (Just it, _, _) -> Left $ "NUMBER: no such style: " <> Text.unpack it+        (Nothing, Just currency, _) -> Right $ Currency currency+        (Nothing, Nothing, Just unit) -> Right $ Unit unit+        (Nothing, Nothing, Nothing) -> Right current++    numberOption :: Identifier -> Value -> Either String (Endo NumberOptions)     numberOption (Identifier name) (asText -> text) = case name of-        "style" -> case text of-            "decimal" -> set (\it options -> options{style = it}) $ Right Decimal-            "percent" -> set (\it options -> options{style = it}) $ Right Percent-            "currency" -> Right mempty-            "unit" -> Right mempty-            it -> Left $ "NUMBER: no such style: " <> Text.unpack it-        "currency" -> set (\it options -> options{style = Currency it}) $ Right text+        "style" -> Right mempty+        "currency" -> Right mempty+        "unit" -> Right mempty+        "type" -> set (\it options -> options{form = it}) parsed         "currencyDisplay" -> set (\it options -> options{currencyDisplay = it}) parsed-        "unit" -> set (\it options -> options{style = Unit it}) $ Right text         "unitDisplay" -> set (\it options -> options{unitDisplay = it}) parsed         "useGrouping" -> set (\it options -> options{useGrouping = it}) $ flag text         "minimumIntegerDigits" ->@@ -70,16 +83,17 @@     count (Text.unpack -> it) = maybe (Left $ "not a count: " <> it) Right . readMaybe $ it  -- | @DATETIME($date, month: "long")@-datetime :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern+datetime :: [Pattern] -> HashMap Identifier Value -> Either String Pattern datetime positional args = do     given <- maybeToEither "DATETIME: expected one positional argument" $ lone positional     case given of-        TimeValue value opts -> do+        Value.Time value opts -> do             change <- changes timeOption args-            pure . Pattern.fromValue . TimeValue value $ appEndo change opts+            pure . Pattern.fromValue . Value.Time value $ appEndo change opts+        Value.Invalid reason -> Left reason         _ -> Left "DATETIME: the positional argument is not a time"   where-    timeOption :: Identifier -> SomeValue -> Either String (Endo TimeOptions)+    timeOption :: Identifier -> Value -> Either String (Endo TimeOptions)     timeOption (Identifier name) (asText -> text) = case name of         "timeZone" -> set (\it options -> options{timeZone = it}) $ zone text         "hour12" -> set (\it options -> options{hour12 = Just it}) $ flag text@@ -106,8 +120,8 @@     zone it = Right it  changes-    :: (Identifier -> SomeValue -> Either String (Endo options))-    -> HashMap Identifier SomeValue+    :: (Identifier -> Value -> Either String (Endo options))+    -> HashMap Identifier Value     -> Either String (Endo options) changes option = fmap mconcat . traverse (uncurry option) . HashMap.toList @@ -128,15 +142,9 @@ set :: (a -> options -> options) -> Either String a -> Either String (Endo options) set change = fmap $ Endo . change -lone :: [Pattern] -> Maybe SomeValue+lone :: [Pattern] -> Maybe Value lone [Pattern (Value it :| [])] = Just it lone _ = Nothing--asText :: SomeValue -> Text-asText (StringValue it) = it-asText (NumberValue it options) | NumberLiteral text <- Number.toLiteral it options = text-asText (TimeValue it _) = Text.show it-asText SomeValue{} = ""  flag :: Text -> Either String Bool flag (Text.unpack -> it)

@@ -0,0 +1,285 @@+-- | This module provides a small English locale.+--+-- The locale is intended for tests and experimentation, not for production use.+--+-- == Supported+--+-- * Cardinal and ordinal plural rules.+-- * Decimal, percent, currency and unit numbers.+-- * Dates and times in UTC.+--+-- == Limitations+--+-- * No regional differences are supported.+--   Every language code with language @en@, such as @en-US@ and @en-GB@, gives the same output.+-- * With the currency display @symbol@, only currencies in 'currencies' have a symbol.+--   Any other currency is shown by its ISO 4217 code.+-- * The currency display @name@ is not supported. It shows the ISO 4217 code like @code@, so+--   @EUR@ gives @EUR 12.50@, not @12.50 euros@.+-- * Only units in 'units' are supported. Any other unit fails.+-- * The unit displays @narrow@ and @long@ are not supported. They show the same abbreviation as+--   @short@, so @long@ gives @3 s@, not @3 seconds@.+-- * Significant digits have no effect.+-- * Era and time zone name fields are left out of dates.+-- * Time zones other than UTC fail.+module Language.Fluent.Locale.English where++import Data.Char qualified as Char+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.List qualified as List+import Data.Maybe qualified as Maybe+import Data.Scientific qualified as Scientific+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Time qualified as Time+import Language.Fluent.Locale (Locale (..))+import Language.Fluent.Number (NumberOptions (..))+import Language.Fluent.Number qualified as NumberOptions+import Language.Fluent.Plural qualified as Plural+import Language.Fluent.Time (TimeOptions (..))+import Language.Fluent.Time qualified as TimeOptions+import Language.Fluent.Width (Width (..))+import Prelude++-- | A small English locale.+--+-- See [the module documentation]("Language.Fluent.Locale.English") for the full list of limitations.+data English = English++-- |+-- ['fromCode']: Accepts any code with language "en", ignoring case:+--+--       * "en", \"EN\", "en-US", and "en_AU" all yield 'English'.+--       * "english" is rejected.+--+-- ['toCode']: Always yields "en".+--+-- ['displayLanguage']: Always yields \"English\".+--+-- ['pluralCategory']:+--+--       * Cardinal: 'Plural.One' for an absolute value of exactly 1 with zero fraction digits;+--                   'Plural.Other' for all other numbers.+--       * Ordinal: 'Plural.One' for numbers ending in 1;+--                  'Plural.Two' for numbers ending in 2;+--                  'Plural.Few' for numbers ending in 3;+--                  'Plural.Other' for all other integers, fractions, and values beyond 'Int'.+--+-- ['formatNumber']: Uses sign, prefix, digits, and suffix layout.+--+--       * Grouping uses commas by default unless disabled.+--       * Percent multiplies by 100 and appends a no-break space and "%".+--       * Currency defaults to ISO 4217 fractional digits, e.g., 0 for JPY.+--       * Units append a no-break space and abbreviation, pluralizing day, week, month, and year+--         with an "s" unless the category is "one".+--+-- ['formatTime']: Renders UTC date and time layouts:+--+--       * Fails if the time zone is anything other than UTC.+--       * Joins weekday, date, and time fields with ", ".+--       * Numeric months, e.g. "21\/08\/2026"+--       * Full month names, e.g. "21 August 2026"+instance Locale English where+    fromCode code+        | Text.toLower (Text.takeWhile Char.isAlpha code) == "en" = Just English+        | otherwise = Nothing++    toCode English = "en"++    displayLanguage English English = Just "English"++    capitalise English (Text.splitAt 1 -> (initial, rest)) = Text.toTitle initial <> rest++    pluralCategory English value options = case options.form of+        Plural.Cardinal+            | abs value == 1 && fst (NumberOptions.fractionDigits options) == 0 -> Plural.One+            | otherwise -> Plural.Other+        Plural.Ordinal -> case Scientific.toBoundedInteger @Int (abs value) of+            Just n | n `mod` 100 `notElem` [11 .. 13] -> case n `mod` 10 of+                1 -> Plural.One+                2 -> Plural.Two+                3 -> Plural.Few+                _ -> Plural.Other+            _ -> Plural.Other++    formatNumber _ value options = case options.style of+        NumberOptions.Decimal -> format "" ""+        NumberOptions.Percent -> format "" "\xA0%"+        NumberOptions.Currency (Text.toUpper -> code)+            | NumberOptions.Symbol <- options.currencyDisplay+            , Just symbol <- HashMap.lookup code currencies ->+                format symbol ""+            | otherwise -> format (code <> "\xA0") ""+        NumberOptions.Unit (NumberOptions.unitIdentifier -> unit) ->+            case HashMap.lookup unit units of+                Nothing -> Left $ "NUMBER: unknown unit: " <> Text.unpack unit+                Just symbol+                    | unit `elem` ["day", "week", "month", "year"]+                    , pluralCategory English value options /= Plural.One ->+                        format "" ("\xA0" <> symbol <> "s")+                    | otherwise -> format "" ("\xA0" <> symbol)+      where+        format before after = Right $ sign <> before <> digits <> after+        sign = if value < 0 then "-" else ""+        amount+            | options.style == NumberOptions.Percent = abs value * 100+            | otherwise = abs value+        (atLeast, atMost) = case options.style of+            NumberOptions.Currency (Text.toUpper -> code)+                | options.minimumFractionDigits == 0+                , Nothing <- options.maximumFractionDigits+                , let places = currencyDigits code ->+                    (places, places)+            _ -> NumberOptions.fractionDigits options+        (whole, fractional) =+            floor @_ @Integer (toRational amount * 10 ^ atMost + 1 / 2) `divMod` (10 ^ atMost)+        padded = Text.justifyRight (NumberOptions.integerDigits options) '0' . Text.show $ whole+        integer+            | options.useGrouping =+                Text.reverse . Text.intercalate "," . Text.chunksOf 3 . Text.reverse $ padded+            | otherwise = padded+        fraction =+            Text.justifyLeft atLeast '0'+                . Text.dropWhileEnd (== '0')+                . Text.justifyRight atMost '0'+                . Text.show+                $ fractional+        digits+            | Text.null fraction = integer+            | otherwise = integer <> "." <> fraction++    formatTime _ when options+        | options.timeZone /= "UTC" =+            Left $ "DATETIME: unsupported time zone: " <> Text.unpack options.timeZone+        | otherwise = Right . Text.pack $ Time.formatTime Time.defaultTimeLocale layout when+      where+        fields = TimeOptions.fields options+        textualMonth = case lookup 'M' fields of+            Just (Right _) -> True+            _ -> False+        layout =+            List.intercalate ", " . filter (not . null) $+                [ part "" "E"+                , part (if textualMonth then " " else "/") "dMy"+                , part ":" "hHjms" <> meridiem+                ]+        meridiem = case lookup 'h' fields of+            Just _ -> " %p"+            Nothing -> ""++        part separator symbols =+            List.intercalate separator $+                Maybe.mapMaybe (\symbol -> render symbol <$> lookup symbol fields) symbols++        render 'E' (Right Long) = "%A"+        render 'E' (Right _) = "%a"+        render 'M' (Right Long) = "%B"+        render 'M' (Right _) = "%b"+        render 'M' (Left _) = "%m"+        render 'd' _ = if textualMonth then "%-d" else "%d"+        render 'y' _ = "%Y"+        render 'h' _ = "%-I"+        render 'H' _ = "%H"+        render 'j' _ = "%H"+        render 'm' _ = "%M"+        render 's' _ = "%S"+        render _ _ = ""++-- | The abbreviations of units of measurement, in the singular, by their CLDR identifier.+units :: HashMap Text Text+units =+    HashMap.fromList . fmap (fmap (Text.drop 1) . Text.breakOn ",") . Text.lines $+        "millimeter,mm\n\+        \centimeter,cm\n\+        \meter,m\n\+        \kilometer,km\n\+        \inch,in\n\+        \foot,ft\n\+        \yard,yd\n\+        \mile,mi\n\+        \square-meter,m²\n\+        \square-kilometer,km²\n\+        \square-foot,sq ft\n\+        \square-mile,sq mi\n\+        \hectare,ha\n\+        \acre,ac\n\+        \milliliter,mL\n\+        \liter,L\n\+        \gallon,gal\n\+        \fluid-ounce,fl oz\n\+        \pint,pt\n\+        \quart,qt\n\+        \tablespoon,tbsp\n\+        \teaspoon,tsp\n\+        \milligram,mg\n\+        \gram,g\n\+        \kilogram,kg\n\+        \ounce,oz\n\+        \pound,lb\n\+        \stone,st\n\+        \metric-ton,t\n\+        \ton,tn\n\+        \millisecond,ms\n\+        \second,s\n\+        \minute,min\n\+        \hour,hr\n\+        \day,day\n\+        \week,wk\n\+        \month,mth\n\+        \year,yr\n\+        \kilometer-per-hour,km/h\n\+        \mile-per-hour,mph\n\+        \meter-per-second,m/s\n\+        \bit,bit\n\+        \byte,byte\n\+        \kilobyte,kB\n\+        \megabyte,MB\n\+        \gigabyte,GB\n\+        \terabyte,TB\n\+        \petabyte,PB\n\+        \watt,W\n\+        \kilowatt,kW\n\+        \megawatt,MW\n\+        \kilowatt-hour,kWh\n\+        \celsius,°C\n\+        \fahrenheit,°F\n\+        \kelvin,K\n\+        \volt,V\n\+        \ampere,A\n\+        \hertz,Hz\n\+        \kilohertz,kHz\n\+        \megahertz,MHz\n\+        \gigahertz,GHz"++-- | The symbols of currencies by their ISO 4217 code.+currencies :: HashMap Text Text+currencies =+    HashMap.fromList . fmap (fmap (Text.drop 1) . Text.breakOn ",") . Text.lines $+        "GBP,£\n\+        \EUR,€\n\+        \USD,$\n\+        \AUD,A$\n\+        \CAD,CA$\n\+        \JPY,¥\n\+        \CNY,CN¥\n\+        \KRW,₩\n\+        \INR,₹\n\+        \HKD,HK$\n\+        \NZD,NZ$\n\+        \BRL,R$\n\+        \MXN,MX$"++-- | The number of digits after the decimal point of an amount of a currency by its ISO 4217 code.+currencyDigits :: Text -> Int+currencyDigits code+    | code `elem` Text.words "BHD JOD KWD LYD OMR TND" = 3+    | code `elem` Text.words "CLF UYW" = 4+    | code `elem` Text.words zeroDigits = 0+    | otherwise = 2+  where+    zeroDigits :: Text+    zeroDigits =+        "ADP AFN ALL BIF BYR CLP COP DJF ESP GNF HUF IDR IQD IRR ISK ITL JPY KMF KPW KRW LAK LBP \+        \LUF MGA MGF MMK MRO PKR PYG RWF SLL SOS STD SYP TMM TRL UGX UYI VND VUV XAF XOF XPF YER \+        \ZMK ZWD"

@@ -1,7 +1,9 @@ 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@@ -36,7 +38,7 @@     deriving stock (Eq, Show, Bounded, Enum)  instance Read CurrencyDisplay where-    readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], fmap toLower (show it) == fmap toLower s]+    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@@ -68,20 +70,26 @@         , 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 = max 0 options.minimumFractionDigits-    atMost = max atLeast $ fromMaybe 3 options.maximumFractionDigits+    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 = max 0 $ fromMaybe 1 options.minimumSignificantDigits-    atMost = max atLeast $ fromMaybe 21 options.maximumSignificantDigits+    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"@@ -94,10 +102,11 @@             <> [width | not $ Text.null width]             <> precision             <> ["group-off" | not options.useGrouping]-            <> [ "integer-width/+" <> Text.replicate options.minimumIntegerDigits "0"-               | options.minimumIntegerDigits > 1-               ]+            <> integerWidth   where+    integerWidth = case integerDigits options of+        1 -> []+        digits -> ["integer-width/+" <> Text.replicate digits "0"]     style', width :: Text     style' = case options.style of         Decimal -> ""@@ -131,7 +140,7 @@     NumberLiteral . Text.pack . formatScientific Fixed (Just digits) $ value   where     digits =-        max options.minimumFractionDigits+        max (fst $ fractionDigits options)             . max 0             . negate             . base10Exponent

@@ -9,24 +9,23 @@ import Data.Maybe (listToMaybe) import Data.String (IsString (..)) import Data.Text (Text)-import Data.Text qualified as Text import Language.Fluent.AST (Identifier) import Language.Fluent.AST qualified as AST-import Language.Fluent.Locale (Locale (..))+import Language.Fluent.Locale (Locale) import Language.Fluent.Number qualified as Number-import Language.Fluent.Value (CustomValue (..), SomeValue (..), Value (..))-import Text.Read (readMaybe)+import Language.Fluent.Value (ToValue (..), Value)+import Language.Fluent.Value qualified as Value import Prelude  -- | A t'AST.Pattern' with all the selections and interpolations resolved down to--- t'SomeValue' and isolation marks.+-- t'Value' and isolation marks. newtype Pattern = Pattern (NonEmpty PatternElement)     deriving newtype (Semigroup, Show)  -- | A single piece of a t'Pattern'. data PatternElement     = -- | A value, ready to be formatted.-      Value SomeValue+      Value Value     | -- | A sequence of values surrounded by isolation marks (FSI, PDI).       Isolated Pattern     deriving stock (Show)@@ -37,65 +36,36 @@ instance IsString PatternElement where     fromString = Value . fromString -instance Value Pattern where-    value = SomeValue . CustomValue--    format locale (Pattern elements) =-        mconcatMapM (format locale) $ NonEmpty.toList elements--instance Value PatternElement where-    value = SomeValue . CustomValue--    format locale (Value v) = format locale v-    format locale (Isolated pattern) = isolate <$> format locale pattern+-- | Format a pattern for the locales, in order of preference.+format :: (Locale l) => NonEmpty l -> Pattern -> Either String Text+format locales (Pattern elements) = mconcatMapM element $ NonEmpty.toList elements+  where+    element (Value v) = Value.format locales v+    element (Isolated inner) = isolate <$> format locales inner  isolate :: Text -> Text isolate = ("\x2068" <>) . (<> "\x2069") -fromValue :: (Value v) => v -> Pattern-fromValue = Pattern . pure . Value . value--interpolates :: AST.Expression -> Bool-interpolates (AST.Inline AST.MessageReference{}) = True-interpolates (AST.Inline AST.TermReference{}) = True-interpolates (AST.Inline AST.StringLiteralExpression{}) = True-interpolates (AST.Inline AST.VariableReference{}) = True-interpolates _ = False+fromValue :: (ToValue v) => v -> Pattern+fromValue = Pattern . pure . Value . toValue  attribute :: Identifier -> [AST.Attribute] -> Maybe AST.Pattern attribute name attributes =     listToMaybe [pattern | AST.Attribute name' pattern <- attributes, name' == name] -termArguments :: Maybe AST.CallArguments -> Either String (HashMap Identifier SomeValue)+termArguments :: Maybe AST.CallArguments -> Either String (HashMap Identifier Value) termArguments Nothing = Right mempty termArguments (Just (AST.CallArguments (partitionEithers -> (named, positional))))     | null positional = Right . HashMap.fromList $ namedArgument <$> named     | otherwise = Left "Positional arguments are not allowed" -namedArgument :: AST.NamedArgument -> (AST.Identifier, SomeValue)+namedArgument :: AST.NamedArgument -> (AST.Identifier, Value) namedArgument (AST.NamedArgument i l) = (i, literal l) -literal :: Either AST.StringLiteral AST.NumberLiteral -> SomeValue-literal (Left s) = StringValue s.value-literal (Right n) = uncurry NumberValue $ Number.fromLiteral n--variantKey :: AST.Variant -> SomeValue-variantKey AST.Variant{key = AST.VariantKey (Left n)} = uncurry NumberValue $ Number.fromLiteral n-variantKey AST.Variant{key = AST.VariantKey (Right (AST.Identifier name))} = StringValue name---- | Whether a selector value exactly equals a variant key.-matchesExact :: SomeValue -> SomeValue -> Bool-matchesExact (StringValue a) (StringValue b) = a == b-matchesExact (NumberValue a _) (NumberValue b _) = a == b-matchesExact _ _ = False+literal :: Either AST.StringLiteral AST.NumberLiteral -> Value+literal (Left s) = Value.String s.value+literal (Right n) = uncurry Value.Number $ Number.fromLiteral n --- | Whether a numeric selector falls into the plural category named by a variant key--- (e.g. a selector of @1@ against the key @one@).-matchesCategory :: (Locale l) => l -> SomeValue -> SomeValue -> Bool-matchesCategory locale selector key = case (selector, key) of-    (StringValue name, NumberValue n options) -> counts n options name-    (NumberValue n options, StringValue name) -> counts n options name-    _ -> False-  where-    counts n options name =-        Just (pluralCategory locale n options) == readMaybe (Text.unpack name)+variantKey :: AST.Variant -> Value+variantKey AST.Variant{key = AST.VariantKey (Left n)} = uncurry Value.Number $ Number.fromLiteral n+variantKey AST.Variant{key = AST.VariantKey (Right (AST.Identifier name))} = Value.String name

@@ -2,8 +2,10 @@ module Language.Fluent.Plural where  import Data.Char (toLower)+import Data.List.Extra (enumerate) import Prelude +-- | A plural category of a number. data Category     = Zero     | One@@ -14,12 +16,13 @@     deriving stock (Eq, Show, Bounded, Enum)  instance Read Category where-    readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], fmap toLower (show it) == fmap toLower s]+    readsPrec _ s = [(it, "") | it <- enumerate, fmap toLower (show it) == fmap toLower s] +-- | The kind of plural category of a number. data Form     = Cardinal     | Ordinal     deriving stock (Eq, Show, Bounded, Enum)  instance Read Form where-    readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], fmap toLower (show it) == fmap toLower s]+    readsPrec _ s = [(it, "") | it <- enumerate, fmap toLower (show it) == fmap toLower s]

@@ -1,6 +1,7 @@ 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@@ -18,7 +19,7 @@     show TwoDigit = "2-digit"  instance Read Digits where-    readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], fmap toLower (show it) == fmap toLower s]+    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

@@ -1,4 +1,3 @@-{-# LANGUAGE RankNTypes #-} {-# OPTIONS_GHC -Wno-name-shadowing #-}  module Language.Fluent.Translate where@@ -21,16 +20,21 @@ import Language.Fluent.Locale (Locale) import Language.Fluent.Parser qualified as Parser import Language.Fluent.Pattern qualified as Pattern-import Language.Fluent.Value (SomeValue, Value (..))+import Language.Fluent.Value (ToValue (..), Value) import Prelude +-- | A target message or attribute lookup. Also carries accumulated variadic parameters. data Reference = Reference     { name :: Either String Identifier     , attribute :: Maybe AttributeAccessor-    , arguments :: HashMap Text SomeValue+    , arguments :: HashMap Text Value     , overrides :: [Bundle.Override]     } +-- | Express a 'Reference' as a string literal:+--+-- - @"message_id"@ targets a top-level message.+-- - @"message_id.attribute_name"@ targets a specific attribute. instance IsString Reference where     fromString s =         Reference@@ -44,8 +48,28 @@             Parser.parseNamed                 "reference"                 ((,) <$> Parser.identifier <*> optional Parser.attributeAccessor)-                (Text.pack s)+                $ Text.pack s +-- | Brings together a message reference, any number of arguments, and a bundle to form a complete+-- translation.+--+-- Instances of this class address three orthogonal concerns:+--+-- - Argument collection. Messages may require arguments before they can be translated.+--   These arguments may be passed directly or resolved implicitly from context.+-- - Bundle resolution. Ultimately all translations come from a bundle.+--   This bundle may be passed directly or resolved implicitly from context.+-- - Return type. Determines a translation's output structure and its failure semantics.+--+-- === Examples:+--+-- > -- Explicit bundle with arguments, returning an Either for safe error handling.+-- > result :: Either String Text+-- > result = translate "welcome" ("name", "Alice") bundle+--+-- > -- Rendering directly to a Miso View, which provides the bundle through the Context.+-- > view :: View Context props model action+-- > view = translate "title" class Translate r where translate :: Reference -> r  instance (Locale locale) => Translate (Bundle locale -> Either String Text) where@@ -61,17 +85,17 @@         arguments <-             HashMap.fromList <$> for (HashMap.toList arguments) \(k, v) ->                 Parser.parseIdentifier k <&> (,v)-        format bundle.locales =<< Bundle.pattern bundle arguments pat+        Pattern.format bundle.locales =<< Bundle.pattern bundle arguments pat -instance (k ~ Text, Value v, Translate r) => Translate ((k, v) -> r) where-    translate reference (k, value -> v) =+instance (k ~ Text, ToValue v, Translate r) => Translate ((k, v) -> r) where+    translate reference (k, toValue -> v) =         translate reference{arguments = HashMap.insert k v reference.arguments} -instance (Foldable f, k ~ Text, Value v, Translate r) => Translate (f (k, v) -> r) where+instance (Foldable f, k ~ Text, ToValue v, Translate r) => Translate (f (k, v) -> r) where     translate reference args =         translate reference{arguments = HashMap.union asked reference.arguments}       where-        asked = HashMap.fromList . fmap (second value) . Foldable.toList $ args+        asked = HashMap.fromList . fmap (second toValue) . Foldable.toList $ args  instance (Translate r) => Translate (Bundle.Override -> r) where     translate reference override = translate reference{overrides = override : reference.overrides}

@@ -1,63 +1,123 @@ module Language.Fluent.Value where +import Data.Int (Int16, Int32, Int64, Int8) import Data.List.NonEmpty (NonEmpty)-import Data.Scientific (Scientific, fromFloatDigits)+import Data.Scientific (Scientific)+import Data.Scientific qualified as Scientific import Data.String (IsString (..)) import Data.Text (Text) import Data.Text qualified as Text import Data.Time (UTCTime)+import Data.Word (Word16, Word32, Word64, Word8)+import Language.Fluent.AST (NumberLiteral (..)) import Language.Fluent.Locale (Locale (..)) import Language.Fluent.Number (NumberOptions, numberOptions)+import Language.Fluent.Number qualified as Number import Language.Fluent.Time (TimeOptions, timeOptions)-import Prelude+import Numeric.Natural (Natural)+import Text.Read (readMaybe)+import Prelude hiding (fromIntegral)+import Prelude qualified -data CustomValue = forall v. (Value v) => CustomValue v+-- | The concrete representation of a Fluent value, along with any formatting options.+data Value+    = -- | A value with custom locale-aware formatting logic.+      Formatted (forall l. (Locale l) => NonEmpty l -> Either String Text)+    | -- | Text that is already formatted.+      String Text+    | -- | A number and its formatting options.+      Number Scientific NumberOptions+    | -- | A point in time and its formatting options.+      Time UTCTime TimeOptions+    | -- | A failed or invalid argument and the error reason.+      Invalid String -class Value v where-    value :: v -> SomeValue-    format :: (Locale l) => NonEmpty l -> v -> Either String Text-    format locale = format locale . value+instance IsString Value where fromString = toValue -data SomeValue-    = StringValue Text-    | NumberValue Scientific NumberOptions-    | TimeValue UTCTime TimeOptions-    | SomeValue CustomValue+instance Show Value where+    show Formatted{} = "Formatted"+    show (String t) = "String " <> show t+    show (Number n _) = "Number " <> show n+    show (Time t _) = "Time " <> show t+    show (Invalid s) = "Invalid " <> show s -instance Value Text where-    value = StringValue-    format _ = Right+-- | Renders a 'Value' into text for the given locale fallback chain.+format :: (Locale l) => NonEmpty l -> Value -> Either String Text+format locales (Formatted f) = f locales+format _ (String s) = Right s+format locales (Number n o) = formatNumber locales n o+format locales (Time t o) = formatTime locales t o+format _ (Invalid reason) = Left reason -instance Value String where value = StringValue . Text.pack+-- | The raw string representation of a 'Value' without applying locale formatting.+asText :: Value -> Text+asText Formatted{} = ""+asText (String it) = it+asText (Number it options) | NumberLiteral text <- Number.toLiteral it options = text+asText (Time it _) = Text.show it+asText (Invalid reason) = Text.pack reason -instance Value Scientific where value = flip NumberValue numberOptions+-- | Whether a selector matches a variant key by exact equality.+matchesExact :: Value -> Value -> Bool+matchesExact (String a) (String b) = a == b+matchesExact (Number a _) (Number b _) = a == b+matchesExact _ _ = False -instance Value Int where value = value . fromIntegral @Int @Scientific+-- | Whether a numeric selector matches a plural category key (e.g. @1@ matching @"one"@).+matchesCategory :: (Locale l) => l -> Value -> Value -> Bool+matchesCategory locale (Number n options) (String name) =+    Just (pluralCategory locale n options) == readMaybe (Text.unpack name)+matchesCategory _ _ _ = False -instance Value Integer where value = value . fromIntegral @Integer @Scientific+-- | Converts an integer into an arbitrary-precision numeric 'Value'.+fromIntegral :: (Integral a) => a -> Value+fromIntegral = toValue @Scientific . Prelude.fromIntegral -instance Value Word where value = value . fromIntegral @Word @Scientific+-- | Converts a floating-point number into an arbitrary-precision numeric 'Value'.+-- Evaluates to 'Invalid' for NaN and infinities.+fromFloatDigits :: (RealFloat a) => a -> Value+fromFloatDigits x+    | isNaN x = Invalid "NaN"+    | isInfinite x = Invalid $ if x < 0 then "-Infinity" else "Infinity"+    | otherwise = toValue $ Scientific.fromFloatDigits x -instance Value Double where value = value . fromFloatDigits+-- | Types usable as arguments in Fluent message formatting.+class ToValue v where toValue :: v -> Value -instance Value UTCTime where value = flip TimeValue timeOptions+instance ToValue Value where toValue = id -instance Value CustomValue where-    value = SomeValue+instance ToValue Text where toValue = String -    format locale (CustomValue v) = format locale v+instance ToValue String where toValue = String . Text.pack -instance IsString SomeValue where fromString = value+instance ToValue Scientific where toValue = flip Number numberOptions -instance Show SomeValue where-    show (StringValue t) = "StringValue " <> Text.unpack t-    show (NumberValue n _) = "NumberValue " <> show n-    show (TimeValue t _) = "TimeValue " <> show t-    show SomeValue{} = "SomeValue"+instance ToValue Int where toValue = fromIntegral -instance Value SomeValue where-    value = id-    format locales (StringValue s) = format locales s-    format locales (NumberValue n o) = formatNumber locales n o-    format locales (TimeValue t o) = formatTime locales t o-    format locales (SomeValue v) = format locales v+instance ToValue Int8 where toValue = fromIntegral++instance ToValue Int16 where toValue = fromIntegral++instance ToValue Int32 where toValue = fromIntegral++instance ToValue Int64 where toValue = fromIntegral++instance ToValue Integer where toValue = fromIntegral++instance ToValue Word where toValue = fromIntegral++instance ToValue Word8 where toValue = fromIntegral++instance ToValue Word16 where toValue = fromIntegral++instance ToValue Word32 where toValue = fromIntegral++instance ToValue Word64 where toValue = fromIntegral++instance ToValue Natural where toValue = fromIntegral++instance ToValue Float where toValue = fromFloatDigits++instance ToValue Double where toValue = fromFloatDigits++instance ToValue UTCTime where toValue = flip Time timeOptions

@@ -1,8 +1,10 @@ module Language.Fluent.Width where  import Data.Char (toLower)+import Data.List.Extra (enumerate) import Prelude +-- | How much of a name to write. data Width     = -- | e.g. @A@, @5s@       Narrow@@ -18,7 +20,7 @@     show Long = "long"  instance Read Width where-    readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], fmap toLower (show it) == fmap toLower s]+    readsPrec _ s = [(it, "") | it <- enumerate, fmap toLower (show it) == fmap toLower s]  -- | How often a date field symbol is repeated in a skeleton for this width, -- e.g. @MMM@ gives 'Short' months, @MMMM@ 'Long' ones and @MMMMM@ 'Narrow' ones.

@@ -1,5 +1,6 @@ module ArgumentSpec (spec) where +import Language.Fluent.Value qualified as Value import Prelude  spec :: Spec@@ -11,7 +12,16 @@     it "is a number with a fraction" $         translate "foo" ("arg", 1.5 :: Scientific) [fluent|foo = { $arg }|] `shouldBe` Right "1.5"     it "is a value the caller has already made" $-        translate "foo" ("arg", StringValue "Bar") [fluent|foo = { $arg }|] `shouldBe` Right "Bar"+        translate "foo" ("arg", Value.String "Bar") [fluent|foo = { $arg }|] `shouldBe` Right "Bar"+    it "is a custom value" $+        translate "foo" ("arg", Value.Formatted \_ -> Right "Bar") [fluent|foo = { $arg }|]+            `shouldBe` Right "Bar"+    it "is a custom value that the locale formats" $+        translate+            "foo"+            ("arg", Value.Formatted \locales -> Value.format locales $ Value.Number 1234 numberOptions)+            [fluent|foo = { $arg }|]+            `shouldBe` Right "1,234"     it "counts the way the locale counts" $         translate             "foo"

@@ -1,8 +1,15 @@ module BuiltinSpec (spec) where  import Data.Foldable (for_)+import Data.Functor (void)+import Data.HashMap.Strict qualified as HashMap+import Data.List.Extra (enumerate)+import Data.List.NonEmpty (NonEmpty (..)) import Data.Text qualified as Text import Data.Time (UTCTime (..), fromGregorian, secondsToDiffTime)+import Language.Fluent.Function qualified as Function+import Language.Fluent.Pattern qualified as Pattern+import Language.Fluent.Value qualified as Value import Prelude  spec :: Spec@@ -11,15 +18,49 @@         it "formats a number by the given options" $             withNumber [fluent|foo = { NUMBER($arg, minimumFractionDigits: 2) }|]                 `shouldBe` Right "3.00"-        it "formats a percentage by the given options" $-            withNumber [fluent|foo = { NUMBER($arg, style: "percent") }|]-                `shouldBe` Right "3%"-        it "formats a currency by the given options" $-            withNumber [fluent|foo = { NUMBER($arg, style: "currency", currency: "EUR") }|]-                `shouldBe` Right "3EUR"-        it "formats a unit by the given options" $-            withNumber [fluent|foo = { NUMBER($arg, style: "unit", unit: "u") }|]-                `shouldBe` Right "3u"+        it "reads the minimum integer digits" $+            numberOptionsWith [("minimumIntegerDigits", "3")]+                `shouldBe` Right numberOptions{minimumIntegerDigits = 3}+        for_+            [ "minimumIntegerDigits"+            , "minimumFractionDigits"+            , "maximumFractionDigits"+            , "minimumSignificantDigits"+            ]+            \option ->+                it (Text.unpack $ "formats a number with " <> option <> " too large to honour") $+                    void (withNumber $ hugeOption option) `shouldBe` Right ()+        it "reads the percent style" $+            numberOptionsWith [("style", "percent")] `shouldBe` Right numberOptions{style = Percent}+        it "reads the currency style and how to display the currency" $+            numberOptionsWith+                [("style", "currency"), ("currency", "EUR"), ("currencyDisplay", "code")]+                `shouldBe` Right numberOptions{style = Currency "EUR", currencyDisplay = Code}+        it "reads the unit style" $+            numberOptionsWith [("style", "unit"), ("unit", "metre")]+                `shouldBe` Right numberOptions{style = Unit "metre"}+        it "ignores a unit where the style is currency" $+            withNumber+                [fluent|+                  foo = { NUMBER($arg, style: "currency", currency: "EUR", unit: "kilometre") }+                |]+                `shouldBe` withNumber+                    [fluent|foo = { NUMBER($arg, style: "currency", currency: "EUR") }|]+        it "rejects the currency style without a currency" $+            withNumber [fluent|foo = { NUMBER($arg, style: "currency") }|]+                `shouldBe` Left "NUMBER: the currency style needs a currency"+        it "rejects the unit style without a unit" $+            withNumber [fluent|foo = { NUMBER($arg, style: "unit") }|]+                `shouldBe` Left "NUMBER: the unit style needs a unit"+        it "selects by the ordinal category of the number when asked to" $+            withNumber+                [fluent|+                  foo = { NUMBER($arg, type: "ordinal") ->+                      [few] few+                     *[other] other+                    }+                |]+                `shouldBe` Right "few"         it "selects by the plural category of the number" $             withNumber                 [fluent|@@ -31,24 +72,53 @@                 `shouldBe` Right "other"      describe "DATETIME" do-        let widths = Text.show <$> [minBound @Width .. maxBound]-        let digits = Text.show <$> [minBound @Digits .. maxBound]-        for_ ((,) <$> (widths <> digits) <*> digits) \(month, year) -> do-            let resource =-                    either error id . parseResource . mconcat . mconcat $-                        [ ["foo = { DATETIME($arg, "]-                        , ["month: \"", month, "\", "]-                        , ["year: \"", year, "\""]-                        , [") }"]-                        ]-            it (Text.unpack $ "with month " <> month <> " and year " <> year) $-                withTime resource `shouldBe` Right "2026-08-10"+        it "reads the fields it is given" $ do+            timeOptionsWith [("year", "numeric")] `shouldBe` Right timeOptions{year = Just Numeric}+            timeOptionsWith [("month", "long")] `shouldBe` Right timeOptions{month = Just $ Right Long}+            timeOptionsWith [("weekday", "long")] `shouldBe` Right timeOptions{weekday = Just Long}+        it "reads whether to use a 12-hour clock" $ do+            timeOptionsWith [("hour12", "true")] `shouldBe` Right timeOptions{hour12 = Just True}+            timeOptionsWith [("hour12", "false")] `shouldBe` Right timeOptions{hour12 = Just False}+        it "rejects a value it does not know" $+            withTime (monthOf "banana") `shouldBe` Left "DATETIME: no such month: banana"+        for_ (enumerate @Width) \width ->+            it (Text.unpack $ "reads the month width " <> Text.show width) $+                timeOptionsWith [("month", toValue $ show width)]+                    `shouldBe` Right timeOptions{month = Just $ Right width}+        for_ (enumerate @Digits) \digits ->+            it (Text.unpack $ "reads the month digits " <> Text.show digits) $+                timeOptionsWith [("month", toValue $ show digits)]+                    `shouldBe` Right timeOptions{month = Just $ Left digits} +hugeOption :: Text -> Resource+hugeOption option =+    either error id . parseResource $+        "foo = { NUMBER($arg, " <> option <> ": 1000000000) }"++monthOf :: Text -> Resource+monthOf month =+    either error id . parseResource $+        "foo = { DATETIME($arg, month: \"" <> month <> "\", year: \"numeric\") }"+ withNumber :: Resource -> Either String Text withNumber = translate "foo" ("arg", 3 :: Int)  withTime :: Resource -> Either String Text-withTime = translate "foo" ("arg", UTCTime date time)-  where-    date = fromGregorian 2026 8 10-    time = secondsToDiffTime $ 12 * 3600 + 34 * 60 + 56+withTime = translate "foo" ("arg", afternoon)++numberOptionsWith :: [(Identifier, Value)] -> Either String NumberOptions+numberOptionsWith named = do+    result <- Function.number [Pattern.fromValue (3 :: Int)] $ HashMap.fromList named+    case result of+        Pattern (Value (Value.Number _ options) :| []) -> Right options+        _ -> Left "not a number"++timeOptionsWith :: [(Identifier, Value)] -> Either String TimeOptions+timeOptionsWith named = do+    result <- Function.datetime [Pattern.fromValue afternoon] $ HashMap.fromList named+    case result of+        Pattern (Value (Value.Time _ options) :| []) -> Right options+        _ -> Left "not a time"++afternoon :: UTCTime+afternoon = UTCTime (fromGregorian 2026 8 10) . secondsToDiffTime $ 12 * 3600 + 34 * 60 + 56

@@ -50,7 +50,7 @@ answers :: Resource -> Expectation answers resource = do     answered <- timeout 100000 . evaluate . length . show $ asked-    answered `shouldSatisfy` (/= Nothing)+    answered `shouldNotBe` Nothing   where     asked :: Either String Text     asked = translate "foo" resource

@@ -0,0 +1,22 @@+module ExpansionSpec (spec) where++import Data.Text qualified as Text+import Prelude++spec :: Spec+spec = do+    it "expands a message that refers to another one twice, a few levels deep" $+        translate "a5" doubling `shouldBe` Right (Text.replicate 32 "x")+    it "stops expanding a message that refers to another one twice, many levels deep" $+        translate "a30" doubling `shouldBe` Left "Too many placeables expanded"++doubling :: Resource+doubling =+    either error id . parseResource . Text.unlines $+        "a0 = x" : (message <$> [1 .. 30 :: Int])++message :: Int -> Text+message n = level n <> " = { " <> level (n - 1) <> " }{ " <> level (n - 1) <> " }"++level :: Int -> Text+level n = "a" <> Text.show n

@@ -110,15 +110,15 @@             [fluent|foo = { FAIL() }|]             `shouldBe` Left "this function always fails" -first :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern+first :: [Pattern] -> HashMap Identifier Value -> Either String Pattern first values _ = maybeToEither "no argument" $ listToMaybe values -greet :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern+greet :: [Pattern] -> HashMap Identifier Value -> Either String Pattern greet _ _ = Right "Hello" -pick :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern+pick :: [Pattern] -> HashMap Identifier Value -> Either String Pattern pick _ named =     Pattern.fromValue <$> maybeToEither "no argument named which" (HashMap.lookup "which" named) -refuse :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern+refuse :: [Pattern] -> HashMap Identifier Value -> Either String Pattern refuse _ _ = Left "this function always fails"

@@ -28,6 +28,23 @@     it "wraps a variable reference" $         translate "foo" (UseIsolating True) ("arg", "Bar" :: Text) [fluent|foo = a { $arg } b|]             `shouldBe` Right "a \8296Bar\8297 b"+    it "wraps a number literal" $+        translate "foo" (UseIsolating True) [fluent|foo = a { 5 } b|]+            `shouldBe` Right "a \8296\&5\8297 b"+    it "wraps a function call" $+        translate "foo" (UseIsolating True) ("arg", 3 :: Int) [fluent|foo = a { NUMBER($arg) } b|]+            `shouldBe` Right "a \8296\&3\8297 b"+    it "wraps a select expression" $+        translate+            "foo"+            (UseIsolating True)+            ("arg", "x" :: Text)+            [fluent|+              foo = a { $arg ->+                 *[x] X+                } b+            |]+            `shouldBe` Right "a \8296X\8297 b"     it "leaves a pattern of one element alone" $         translate             "foo"

@@ -1,5 +1,7 @@ module LiteralSpec (spec) where +import Data.Char qualified as Char+import Data.Text qualified as Text import Prelude  spec :: Spec@@ -31,8 +33,9 @@             translate "foo" [fluent|foo = { 0.50 }|] `shouldBe` Right "0.50"         it "keeps every digit it was written with, however many" $             translate "foo" [fluent|foo = { 0.1234 }|] `shouldBe` Right "0.1234"-        it "keeps every digit of a number of many, which the locale is left to group" $-            translate "foo" [fluent|foo = { 1234567 }|] `shouldBe` Right "1234567"+        it "keeps every digit of a number of many, however the locale groups them" $+            (Text.filter Char.isDigit <$> translate "foo" [fluent|foo = { 1234567 }|])+                `shouldBe` Right "1234567"      describe "placeable" do         it "holds a placeable of its own" $

@@ -13,50 +13,17 @@     ) where -import Data.Char (toUpper) import Data.Scientific (Scientific) import Data.String (IsString (..)) import Data.Text (Text) import Data.Text qualified as Text-import Data.Time qualified as Time import Language.Fluent-import Language.Fluent.AST (NumberLiteral (..)) import Language.Fluent.Bundle qualified as Bundle-import Language.Fluent.Number qualified as Number+import Language.Fluent.Locale.English (English (..)) import Language.Fluent.Parser qualified as Parser-import Language.Fluent.Plural qualified as Plural import Test.Hspec import "base" Prelude -data Plain = Plain--instance Locale Plain where-    fromCode "plain" = Just Plain-    fromCode _ = Nothing--    toCode _ = "plain"--    displayLanguage Plain Plain = Just "plain"--    capitalise Plain (Text.uncons -> Just (x, xs)) = Text.cons (toUpper x) xs-    capitalise Plain t = t--    pluralCategory _ value options-        | options.form == Plural.Ordinal = Plural.Other-        | abs value == 1 = Plural.One-        | otherwise = Plural.Other--    formatNumber _ amount options = case options.style of-        Decimal -> Right decimal-        Percent -> Right $ decimal <> "%"-        Currency c -> Right $ decimal <> c-        Unit u -> Right $ decimal <> u-      where-        NumberLiteral decimal = Number.toLiteral amount options--    formatTime _ when _ =-        Right . Text.pack $ Time.formatTime Time.defaultTimeLocale "%Y-%m-%d" when- instance IsString Identifier where     fromString = either error id . Parser.parseIdentifier . Text.pack @@ -64,5 +31,5 @@     translate reference =         translate reference             . Bundle.override (Bundle.UseIsolating False)-            . bundle (pure Plain)+            . bundle (pure English)             . pure

@@ -25,6 +25,36 @@                 }             |]             `shouldBe` Right "Zero"+    it "does not match a number key by the plural category of the key" $+        translate+            "foo"+            ("arg", "other" :: Text)+            [fluent|+              foo = { $arg ->+                  [0] Zero+                 *[x] Default+                }+            |]+            `shouldBe` Right "Default"+    it "fails when the selector is a call of a function that does not exist" $+        translate+            "foo"+            [fluent|+              foo = { MISSING() ->+                 *[a] A+                }+            |]+            `shouldBe` Left "Function not found: \"MISSING\""+    it "fails when the selector is a call that fails" $+        translate+            "foo"+            ("arg", "x" :: Text)+            [fluent|+              foo = { NUMBER($arg) ->+                 *[a] A+                }+            |]+            `shouldBe` Left "NUMBER: the positional argument is not a number"     it "matches a number key against a fraction" $         translate "foo" ("arg", 1.5 :: Scientific) numbers `shouldBe` Right "Other"     it "holds a select of its own in the variant it picks" $

@@ -0,0 +1,43 @@+module ValueSpec (spec) where++import Data.Int (Int16, Int64, Int8)+import Data.Word (Word16, Word64, Word8)+import Foreign.C.Types (CDouble, CInt)+import Language.Fluent.Value qualified as Value+import Numeric.Natural (Natural)+import Prelude++spec :: Spec+spec = do+    describe "integer" do+        it "is formatted as a number" $ do+            written (-5 :: Int8) `shouldBe` Right "-5"+            written (200 :: Word8) `shouldBe` Right "200"+            written (-300 :: Int16) `shouldBe` Right "-300"+            written (7 :: Word16) `shouldBe` Right "7"+            written (9 :: Natural) `shouldBe` Right "9"+        it "is formatted as a number if it has no instance" $+            written (Value.fromIntegral (-3 :: CInt)) `shouldBe` Right "-3"+        it "keeps every digit of the largest" $ do+            written (maxBound @Int64) `shouldBe` Right "9,223,372,036,854,775,807"+            written (maxBound @Word64) `shouldBe` Right "18,446,744,073,709,551,615"++    describe "floating point number" do+        it "is formatted with the digits that identify it" $ do+            written (0.1 :: Double) `shouldBe` Right "0.1"+            written (0.1 :: Float) `shouldBe` Right "0.1"+            written (Value.fromFloatDigits (1.5 :: CDouble)) `shouldBe` Right "1.5"+        it "is not a number if it is NaN" $ do+            written (0 / 0 :: Double) `shouldBe` Left "NaN"+            written (0 / 0 :: Float) `shouldBe` Left "NaN"+        it "is not a number if it is infinite" $ do+            written (1 / 0 :: Double) `shouldBe` Left "Infinity"+            written (-(1 / 0) :: Float) `shouldBe` Left "-Infinity"+        it "is not a number to a function that expects one" $+            translate "foo" ("arg", 0 / 0 :: Double) [fluent|foo = { NUMBER($arg) }|]+                `shouldBe` Left "NaN"+        it "is only an error where it is used" $+            translate "foo" ("arg", 0 / 0 :: Double) [fluent|foo = Hello|] `shouldBe` Right "Hello"++written :: (ToValue v) => v -> Either String Text+written v = translate "foo" ("arg", toValue v) [fluent|foo = { $arg }|]

@@ -1,5 +1,6 @@ module VariableSpec (spec) where +import Language.Fluent.Value qualified as Value import Prelude  spec :: Spec@@ -19,7 +20,7 @@     it "shows as many fraction digits as the number holds" $         translate             "foo"-            ("arg", NumberValue 1 numberOptions{minimumFractionDigits = 2})+            ("arg", Value.Number 1 numberOptions{minimumFractionDigits = 2})             [fluent|foo = { $arg }|]             `shouldBe` Right "1.00"     it "is missing" $