fluent (empty) → 1.0.0
raw patch · 27 files changed
+2325/−0 lines, 27 filesdep +basedep +extradep +fluentsetup-changed
Dependencies added: base, extra, fluent, fluent-syntax, hspec, scientific, text, time, unordered-containers
Files
- CHANGELOG.md +12/−0
- LICENCE +287/−0
- Setup.hs +2/−0
- fluent.cabal +126/−0
- src/Language/Fluent.hs +60/−0
- src/Language/Fluent/Bundle.hs +237/−0
- src/Language/Fluent/Function.hs +145/−0
- src/Language/Fluent/Locale.hs +43/−0
- src/Language/Fluent/Number.hs +139/−0
- src/Language/Fluent/Pattern.hs +101/−0
- src/Language/Fluent/Plural.hs +25/−0
- src/Language/Fluent/Time.hs +99/−0
- src/Language/Fluent/Translate.hs +77/−0
- src/Language/Fluent/Value.hs +63/−0
- src/Language/Fluent/Width.hs +29/−0
- test/ArgumentSpec.hs +32/−0
- test/BuiltinSpec.hs +54/−0
- test/CycleSpec.hs +56/−0
- test/FunctionSpec.hs +124/−0
- test/IsolationSpec.hs +48/−0
- test/LiteralSpec.hs +51/−0
- test/Main.hs +1/−0
- test/MessageSpec.hs +130/−0
- test/Prelude.hs +68/−0
- test/ReferenceSpec.hs +129/−0
- test/SelectSpec.hs +152/−0
- test/VariableSpec.hs +35/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog++All notable changes to this project will be documented in this file.++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.0.0] - 2026-10-01++### Added++- Initial release.
+ LICENCE view
@@ -0,0 +1,287 @@+ EUROPEAN UNION PUBLIC LICENCE v. 1.2+ EUPL © the European Union 2007, 2016++This European Union Public Licence (the ‘EUPL’) applies to the Work (as defined+below) which is provided under the terms of this Licence. Any use of the Work,+other than as authorised under this Licence is prohibited (to the extent such+use is covered by a right of the copyright holder of the Work).++The Work is provided under the terms of this Licence when the Licensor (as+defined below) has placed the following notice immediately following the+copyright notice for the Work:++ Licensed under the EUPL++or has expressed by any other means his willingness to license under the EUPL.++1. Definitions++In this Licence, the following terms have the following meaning:++- ‘The Licence’: this Licence.++- ‘The Original Work’: the work or software distributed or communicated by the+ Licensor under this Licence, available as Source Code and also as Executable+ Code as the case may be.++- ‘Derivative Works’: the works or software that could be created by the+ Licensee, based upon the Original Work or modifications thereof. This Licence+ does not define the extent of modification or dependence on the Original Work+ required in order to classify a work as a Derivative Work; this extent is+ determined by copyright law applicable in the country mentioned in Article 15.++- ‘The Work’: the Original Work or its Derivative Works.++- ‘The Source Code’: the human-readable form of the Work which is the most+ convenient for people to study and modify.++- ‘The Executable Code’: any code which has generally been compiled and which is+ meant to be interpreted by a computer as a program.++- ‘The Licensor’: the natural or legal person that distributes or communicates+ the Work under the Licence.++- ‘Contributor(s)’: any natural or legal person who modifies the Work under the+ Licence, or otherwise contributes to the creation of a Derivative Work.++- ‘The Licensee’ or ‘You’: any natural or legal person who makes any usage of+ the Work under the terms of the Licence.++- ‘Distribution’ or ‘Communication’: any act of selling, giving, lending,+ renting, distributing, communicating, transmitting, or otherwise making+ available, online or offline, copies of the Work or providing access to its+ essential functionalities at the disposal of any other natural or legal+ person.++2. Scope of the rights granted by the Licence++The Licensor hereby grants You a worldwide, royalty-free, non-exclusive,+sublicensable licence to do the following, for the duration of copyright vested+in the Original Work:++- use the Work in any circumstance and for all usage,+- reproduce the Work,+- modify the Work, and make Derivative Works based upon the Work,+- communicate to the public, including the right to make available or display+ the Work or copies thereof to the public and perform publicly, as the case may+ be, the Work,+- distribute the Work or copies thereof,+- lend and rent the Work or copies thereof,+- sublicense rights in the Work or copies thereof.++Those rights can be exercised on any media, supports and formats, whether now+known or later invented, as far as the applicable law permits so.++In the countries where moral rights apply, the Licensor waives his right to+exercise his moral right to the extent allowed by law in order to make effective+the licence of the economic rights here above listed.++The Licensor grants to the Licensee royalty-free, non-exclusive usage rights to+any patents held by the Licensor, to the extent necessary to make use of the+rights granted on the Work under this Licence.++3. Communication of the Source Code++The Licensor may provide the Work either in its Source Code form, or as+Executable Code. If the Work is provided as Executable Code, the Licensor+provides in addition a machine-readable copy of the Source Code of the Work+along with each copy of the Work that the Licensor distributes or indicates, in+a notice following the copyright notice attached to the Work, a repository where+the Source Code is easily and freely accessible for as long as the Licensor+continues to distribute or communicate the Work.++4. Limitations on copyright++Nothing in this Licence is intended to deprive the Licensee of the benefits from+any exception or limitation to the exclusive rights of the rights owners in the+Work, of the exhaustion of those rights or of other applicable limitations+thereto.++5. Obligations of the Licensee++The grant of the rights mentioned above is subject to some restrictions and+obligations imposed on the Licensee. Those obligations are the following:++Attribution right: The Licensee shall keep intact all copyright, patent or+trademarks notices and all notices that refer to the Licence and to the+disclaimer of warranties. The Licensee must include a copy of such notices and a+copy of the Licence with every copy of the Work he/she distributes or+communicates. The Licensee must cause any Derivative Work to carry prominent+notices stating that the Work has been modified and the date of modification.++Copyleft clause: If the Licensee distributes or communicates copies of the+Original Works or Derivative Works, this Distribution or Communication will be+done under the terms of this Licence or of a later version of this Licence+unless the Original Work is expressly distributed only under this version of the+Licence — for example by communicating ‘EUPL v. 1.2 only’. The Licensee+(becoming Licensor) cannot offer or impose any additional terms or conditions on+the Work or Derivative Work that alter or restrict the terms of the Licence.++Compatibility clause: If the Licensee Distributes or Communicates Derivative+Works or copies thereof based upon both the Work and another work licensed under+a Compatible Licence, this Distribution or Communication can be done under the+terms of this Compatible Licence. For the sake of this clause, ‘Compatible+Licence’ refers to the licences listed in the appendix attached to this Licence.+Should the Licensee's obligations under the Compatible Licence conflict with+his/her obligations under this Licence, the obligations of the Compatible+Licence shall prevail.++Provision of Source Code: When distributing or communicating copies of the Work,+the Licensee will provide a machine-readable copy of the Source Code or indicate+a repository where this Source will be easily and freely available for as long+as the Licensee continues to distribute or communicate the Work.++Legal Protection: This Licence does not grant permission to use the trade names,+trademarks, service marks, or names of the Licensor, except as required for+reasonable and customary use in describing the origin of the Work and+reproducing the content of the copyright notice.++6. Chain of Authorship++The original Licensor warrants that the copyright in the Original Work granted+hereunder is owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each Contributor warrants that the copyright in the modifications he/she brings+to the Work are owned by him/her or licensed to him/her and that he/she has the+power and authority to grant the Licence.++Each time You accept the Licence, the original Licensor and subsequent+Contributors grant You a licence to their contributions to the Work, under the+terms of this Licence.++7. Disclaimer of Warranty++The Work is a work in progress, which is continuously improved by numerous+Contributors. It is not a finished work and may therefore contain defects or+‘bugs’ inherent to this type of development.++For the above reason, the Work is provided under the Licence on an ‘as is’ basis+and without warranties of any kind concerning the Work, including without+limitation merchantability, fitness for a particular purpose, absence of defects+or errors, accuracy, non-infringement of intellectual property rights other than+copyright as stated in Article 6 of this Licence.++This disclaimer of warranty is an essential part of the Licence and a condition+for the grant of any rights to the Work.++8. Disclaimer of Liability++Except in the cases of wilful misconduct or damages directly caused to natural+persons, the Licensor will in no event be liable for any direct or indirect,+material or moral, damages of any kind, arising out of the Licence or of the use+of the Work, including without limitation, damages for loss of goodwill, work+stoppage, computer failure or malfunction, loss of data or any commercial+damage, even if the Licensor has been advised of the possibility of such damage.+However, the Licensor will be liable under statutory product liability laws as+far such laws apply to the Work.++9. Additional agreements++While distributing the Work, You may choose to conclude an additional agreement,+defining obligations or services consistent with this Licence. However, if+accepting obligations, You may act only on your own behalf and on your sole+responsibility, not on behalf of the original Licensor or any other Contributor,+and only if You agree to indemnify, defend, and hold each Contributor harmless+for any liability incurred by, or claims asserted against such Contributor by+the fact You have accepted any warranty or additional liability.++10. Acceptance of the Licence++The provisions of this Licence can be accepted by clicking on an icon ‘I agree’+placed under the bottom of a window displaying the text of this Licence or by+affirming consent in any other similar way, in accordance with the rules of+applicable law. Clicking on that icon indicates your clear and irrevocable+acceptance of this Licence and all of its terms and conditions.++Similarly, you irrevocably accept this Licence and all of its terms and+conditions by exercising any rights granted to You by Article 2 of this Licence,+such as the use of the Work, the creation by You of a Derivative Work or the+Distribution or Communication by You of the Work or copies thereof.++11. Information to the public++In case of any Distribution or Communication of the Work by means of electronic+communication by You (for example, by offering to download the Work from a+remote location) the distribution channel or media (for example, a website) must+at least provide to the public the information requested by the applicable law+regarding the Licensor, the Licence and the way it may be accessible, concluded,+stored and reproduced by the Licensee.++12. Termination of the Licence++The Licence and the rights granted hereunder will terminate automatically upon+any breach by the Licensee of the terms of the Licence.++Such a termination will not terminate the licences of any person who has+received the Work from the Licensee under the Licence, provided such persons+remain in full compliance with the Licence.++13. Miscellaneous++Without prejudice of Article 9 above, the Licence represents the complete+agreement between the Parties as to the Work.++If any provision of the Licence is invalid or unenforceable under applicable+law, this will not affect the validity or enforceability of the Licence as a+whole. Such provision will be construed or reformed so as necessary to make it+valid and enforceable.++The European Commission may publish other linguistic versions or new versions of+this Licence or updated versions of the Appendix, so far this is required and+reasonable, without reducing the scope of the rights granted by the Licence. New+versions of the Licence will be published with a unique version number.++All linguistic versions of this Licence, approved by the European Commission,+have identical value. Parties can take advantage of the linguistic version of+their choice.++14. Jurisdiction++Without prejudice to specific agreement between parties,++- any litigation resulting from the interpretation of this License, arising+ between the European Union institutions, bodies, offices or agencies, as a+ Licensor, and any Licensee, will be subject to the jurisdiction of the Court+ of Justice of the European Union, as laid down in article 272 of the Treaty on+ the Functioning of the European Union,++- any litigation arising between other parties and resulting from the+ interpretation of this License, will be subject to the exclusive jurisdiction+ of the competent court where the Licensor resides or conducts its primary+ business.++15. Applicable Law++Without prejudice to specific agreement between parties,++- this Licence shall be governed by the law of the European Union Member State+ where the Licensor has his seat, resides or has his registered office,++- this licence shall be governed by Belgian law if the Licensor has no seat,+ residence or registered office inside a European Union Member State.++Appendix++‘Compatible Licences’ according to Article 5 EUPL are:++- GNU General Public License (GPL) v. 2, v. 3+- GNU Affero General Public License (AGPL) v. 3+- Open Software License (OSL) v. 2.1, v. 3.0+- Eclipse Public License (EPL) v. 1.0+- CeCILL v. 2.0, v. 2.1+- Mozilla Public Licence (MPL) v. 2+- GNU Lesser General Public Licence (LGPL) v. 2.1, v. 3+- Creative Commons Attribution-ShareAlike v. 3.0 Unported (CC BY-SA 3.0) for+ works other than software+- European Union Public Licence (EUPL) v. 1.1, v. 1.2+- Québec Free and Open-Source Licence — Reciprocity (LiLiQ-R) or Strong+ Reciprocity (LiLiQ-R+).++The European Commission may update this Appendix to later versions of the above+licences without producing a new version of the EUPL, as long as they provide+the rights granted in Article 2 of this Licence and protect the covered Source+Code from exclusive appropriation.++All other changes or additions to this Appendix require the production of a new+EUPL version.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ fluent.cabal view
@@ -0,0 +1,126 @@+cabal-version: 3.0+name: fluent+version: 1.0.0+synopsis: Haskell implementation of Project Fluent+description:+ This library implements <https://projectfluent.org Project Fluent>,+ a localisation system designed to unleash the entire expressive power of natural+ language translations.++ Project Fluent keeps simple things simple and makes complex things possible.+ The syntax used for describing translations is easy to read and understand.+ At the same time it allows, when necessary, to represent complex concepts from+ natural languages like gender, plurals, conjugations, and others.++license: EUPL-1.2+license-file: LICENCE+author: IDA+maintainer: IDA+homepage: https://digital-autonomy.institute+bug-reports: https://issues.digital-autonomy.institute+category: Language+build-type: Simple+extra-doc-files:+ CHANGELOG.md++common common+ default-language: Haskell2010+ 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+ RecordWildCards+ RecursiveDo+ ScopedTypeVariables+ StrictData+ TupleSections+ TypeApplications+ TypeFamilies+ TypeOperators+ TypeSynonymInstances+ ViewPatterns++ ghc-options:+ -Weverything+ -Wno-unsafe+ -Wno-missing-safe-haskell-mode+ -Wno-missing-export-lists+ -Wno-missing-import-lists+ -Wno-missing-kind-signatures+ -Wno-missing-role-annotations+ -Wno-all-missed-specialisations++library+ import: common+ hs-source-dirs: src+ build-depends:+ base >=4 && <5,+ extra >=1.6 && <1.9,+ fluent-syntax >=1.0 && <1.1,+ scientific >=0.3 && <0.4,+ text >=2.1.2 && <2.2,+ time >=1.12 && <1.17,+ unordered-containers >=0.2 && <0.3,++ exposed-modules:+ Language.Fluent+ Language.Fluent.Bundle+ Language.Fluent.Function+ Language.Fluent.Locale+ Language.Fluent.Number+ Language.Fluent.Pattern+ Language.Fluent.Plural+ Language.Fluent.Time+ Language.Fluent.Translate+ Language.Fluent.Value+ Language.Fluent.Width++test-suite test+ import: common+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ ArgumentSpec+ BuiltinSpec+ CycleSpec+ FunctionSpec+ IsolationSpec+ LiteralSpec+ MessageSpec+ Prelude+ ReferenceSpec+ SelectSpec+ VariableSpec++ build-depends:+ base >=4 && <5,+ extra >=1.6 && <1.9,+ fluent,+ fluent-syntax >=1.0 && <1.1,+ hspec >=2.11 && <2.12,+ scientific >=0.3 && <0.4,+ text >=2.1.2 && <2.2,+ time >=1.12 && <1.17,+ unordered-containers >=0.2 && <0.3,
+ src/Language/Fluent.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : Language.Fluent+-- Copyright : (c) 2026 Institute for Digital Autonomy+-- License : EUPL-1.2+-- Maintainer : IDA+--+-- <https://projectfluent.org Project Fluent> is a localisation system designed+-- to unleash the entire expressive power of natural language translations.+--+-- This library provides the core Fluent translation machinery to go from parsed+-- 'Resource's to translated messages:+--+-- * the 'Locale' typeclass which supplies locale-specific operations+-- * 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:+--+-- * <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>,+-- backed by the browser's @Intl@ API+module Language.Fluent+ ( module Language.Fluent.AST+ , module Language.Fluent.Bundle+ , module Language.Fluent.Locale+ , module Language.Fluent.Number+ , module Language.Fluent.Parser+ , module Language.Fluent.Pattern+ , module Language.Fluent.Plural+ , module Language.Fluent.TH+ , module Language.Fluent.Time+ , module Language.Fluent.Translate+ , module Language.Fluent.Value+ , module Language.Fluent.Width+ )+where++import Language.Fluent.AST (Identifier, Resource)+import Language.Fluent.Bundle (Bundle (..), Override (..), bundle)+import Language.Fluent.Locale+import Language.Fluent.Number+ ( CurrencyDisplay (..)+ , NumberOptions (..)+ , Style (..)+ , numberOptions+ )+import Language.Fluent.Parser (parseResource)+import Language.Fluent.Pattern (Pattern (..), PatternElement (..))+import Language.Fluent.Plural (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.Width (Width (..))
+ src/Language/Fluent/Bundle.hs view
@@ -0,0 +1,237 @@+{- HLINT ignore "Use zipWithM" -}+{-# OPTIONS_GHC -Wno-name-shadowing #-}++module Language.Fluent.Bundle where++import Control.Applicative ((<|>))+import Control.Monad (guard)+import Data.Coerce (coerce)+import Data.Either (partitionEithers)+import Data.Either.Extra (maybeToEither)+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.HashSet (HashSet)+import Data.HashSet qualified as HashSet+import Data.Kind (Type)+import Data.List qualified as List+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Maybe (listToMaybe)+import Data.Semigroup (sconcat)+import Data.Text (Text)+import Data.Text qualified as Text+import Language.Fluent.AST (Identifier (Identifier), Resource (Resource))+import Language.Fluent.AST qualified as AST+import Language.Fluent.Function (builtins)+import Language.Fluent.Locale (Locale)+import Language.Fluent.Locale qualified as Locale+import Language.Fluent.Number qualified as Number+import Language.Fluent.Pattern+ ( Pattern (..)+ , PatternElement (..)+ , attribute+ , interpolates+ , matchesCategory+ , matchesExact+ , namedArgument+ , termArguments+ , variantKey+ )+import Language.Fluent.Pattern qualified as Pattern+import Language.Fluent.Value (SomeValue (..))+import Prelude++-- | A collection of Fluent resources and the configuration needed to+-- resolve and format messages for a locale.+data Bundle (locale :: Type) = Bundle+ { locales :: NonEmpty locale+ -- ^ The locale of the messages, followed by the fallback locales for number and date formatting.+ , resources :: [Resource]+ -- ^ Message and term definitions, searched in order.+ , functions+ :: HashMap+ Identifier+ ( [Pattern]+ -> HashMap Identifier SomeValue+ -> Either String Pattern+ )+ -- ^ Functions available to messages, shadowing the builtins of the same name.+ , useIsolating :: Bool+ -- ^ Whether to use isolation marks (FSI, PDI) around interpolated values.+ }++data Override+ = UseIsolating Bool+ | WithFunction Identifier ([Pattern] -> HashMap Identifier SomeValue -> Either String Pattern)++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}++localeCodes :: (Locale locale) => Bundle locale -> NonEmpty Text+localeCodes Bundle{locales} = Locale.toCode <$> locales++-- | Only the names of the @functions@ are compared, since their implementations+-- cannot be compared for equality.+instance (Locale locale) => Eq (Bundle locale) where+ b1 == b2 =+ localeCodes b1 == localeCodes b2+ && b1.resources == b2.resources+ && HashMap.keysSet b1.functions == HashMap.keysSet b2.functions+ && b1.useIsolating == b2.useIsolating++instance (Locale locale) => Show (Bundle locale) where+ show bundle =+ Text.unpack $+ "Bundle{"+ <> Text.intercalate+ ","+ [ locales+ , resources+ , functions+ , useIsolating+ ]+ <> "}"+ where+ locales =+ "locales=" <> Text.show (NonEmpty.toList . localeCodes $ bundle)+ resources = "resources=" <> Text.show bundle.resources+ functions = "functions=" <> Text.show (HashMap.keys bundle.functions)+ useIsolating = "useIsolating=" <> Text.show bundle.useIsolating++bundle :: NonEmpty locale -> [Resource] -> Bundle locale+bundle locales resources = Bundle{locales, resources, functions = mempty, useIsolating = True}++message :: Identifier -> Bundle locale -> Maybe AST.Message+message id Bundle{resources} = listToMaybe do+ Resource{entries} <- resources+ AST.MessageEntry found <- entries+ guard $ found.id == id+ pure found++term :: Identifier -> Bundle locale -> Maybe AST.Term+term name Bundle{resources} = listToMaybe do+ Resource{entries} <- resources+ AST.TermEntry found <- entries+ guard $ found.id == name+ pure found++pattern+ :: (Locale locale)+ => Bundle locale+ -> HashMap Identifier SomeValue+ -> AST.Pattern+ -> Either String Pattern+pattern bundle@Bundle{locales = locale :| _, ..} = resolve mempty+ where+ resolve+ :: HashSet Identifier+ -> HashMap Identifier SomeValue+ -> AST.Pattern+ -> 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+ 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++ expression+ :: HashSet Identifier+ -> HashMap Identifier SomeValue+ -> AST.Expression+ -> 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"+ AST.Variant{value = picked'} <-+ maybeToEither "Select expression has no default variant" $+ picked <|> List.find AST.isDefault variants+ resolve followed arguments picked'++ inlineExpression+ :: HashSet Identifier+ -> HashMap Identifier SomeValue+ -> AST.InlineExpression+ -> Either String Pattern+ inlineExpression _ _ (AST.StringLiteralExpression s) = Right . Pattern.fromValue $ s.value+ inlineExpression _ _ (AST.NumberLiteralExpression n) =+ Right . Pattern.fromValue . uncurry NumberValue $ 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)+ inlineExpression followed arguments (AST.FunctionReference id called) = do+ let AST.CallArguments args = called+ f <-+ 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+ inlineExpression followed arguments (AST.MessageReference id accessor) = do+ found <-+ maybeToEither ("Message not found: " <> Text.unpack (coerce id)) $ message id bundle+ found' <- 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++ attributeOf+ :: Identifier+ -> Identifier+ -> [AST.Attribute]+ -> Either String AST.Pattern+ attributeOf owner name attributes =+ maybeToEither ("Attribute not found: " <> show (owner, name)) $+ attribute name attributes++ withDash :: Identifier -> Identifier+ withDash (Identifier i) = Identifier $ "-" <> i++ reference :: Identifier -> Maybe AST.AttributeAccessor -> Identifier+ reference (Identifier name) (Just (AST.AttributeAccessor (Identifier it))) = Identifier $ name <> "." <> it+ reference name _ = name++ follow+ :: HashSet Identifier+ -> HashMap Identifier SomeValue+ -> Identifier+ -> AST.Pattern+ -> Either String Pattern+ follow followed arguments name found+ | name `HashSet.member` followed = Left $ "Cyclic reference: " <> show name+ | otherwise = resolve (HashSet.insert name followed) arguments found
+ src/Language/Fluent/Function.hs view
@@ -0,0 +1,145 @@+module Language.Fluent.Function where++import Data.Either.Extra (maybeToEither)+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.List qualified as List+import Data.List.NonEmpty (NonEmpty (..))+import Data.Monoid (Endo (..))+import Data.Text (Text)+import Data.Text qualified as Text+import Language.Fluent.AST (Identifier (..), NumberLiteral (..))+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.Width (Width)+import Text.Read (readMaybe)+import Prelude++builtins+ :: HashMap+ Identifier+ ( [Pattern]+ -> HashMap Identifier SomeValue+ -> 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 positional args = do+ given <- maybeToEither "NUMBER: expected one positional argument" $ lone positional+ case given of+ NumberValue value opts -> do+ change <- changes numberOption args+ pure . Pattern.fromValue . NumberValue value $ appEndo change opts+ _ -> Left "NUMBER: the positional argument is not a number"+ where+ numberOption :: Identifier -> SomeValue -> 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+ "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" ->+ set (\it options -> options{minimumIntegerDigits = it}) $ count text+ "minimumFractionDigits" ->+ set (\it options -> options{minimumFractionDigits = it}) $ count text+ "maximumFractionDigits" ->+ set (\it options -> options{maximumFractionDigits = Just it}) $ count text+ "minimumSignificantDigits" ->+ set (\it options -> options{minimumSignificantDigits = Just it}) $ count text+ "maximumSignificantDigits" ->+ set (\it options -> options{maximumSignificantDigits = Just it}) $ count text+ it -> Left $ "NUMBER: no such option: " <> Text.unpack it+ where+ parsed :: (Bounded a, Enum a, Read a, Show a) => Either String a+ parsed = named "NUMBER" name text++ count :: Text -> Either String Int+ 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 positional args = do+ given <- maybeToEither "DATETIME: expected one positional argument" $ lone positional+ case given of+ TimeValue value opts -> do+ change <- changes timeOption args+ pure . Pattern.fromValue . TimeValue value $ appEndo change opts+ _ -> Left "DATETIME: the positional argument is not a time"+ where+ timeOption :: Identifier -> SomeValue -> 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+ "weekday" -> set (\it options -> options{weekday = Just it}) parsed+ "era" -> set (\it options -> options{era = Just it}) parsed+ "year" -> set (\it options -> options{year = Just it}) parsed+ "month" -> set (\it options -> options{month = Just it}) monthField+ "day" -> set (\it options -> options{day = Just it}) parsed+ "hour" -> set (\it options -> options{hour = Just it}) parsed+ "minute" -> set (\it options -> options{minute = Just it}) parsed+ "second" -> set (\it options -> options{second = Just it}) parsed+ "timeZoneName" -> set (\it options -> options{timeZoneName = Just it}) parsed+ it -> Left $ "DATETIME: no such option: " <> Text.unpack it+ where+ parsed :: (Bounded a, Enum a, Read a, Show a) => Either String a+ parsed = named "DATETIME" name text+ monthField+ | Right digits <- parsed @Digits = Right $ Left digits+ | Right width <- parsed @Width = Right $ Right width+ | otherwise = Left $ "DATETIME: no such month: " <> Text.unpack text++ zone :: Text -> Either String Text+ zone "" = Left "DATETIME: the timeZone names no zone"+ zone it = Right it++changes+ :: (Identifier -> SomeValue -> Either String (Endo options))+ -> HashMap Identifier SomeValue+ -> Either String (Endo options)+changes option = fmap mconcat . traverse (uncurry option) . HashMap.toList++named :: forall a. (Bounded a, Enum a, Read a, Show a) => String -> Text -> Text -> Either String a+named fn (Text.unpack -> what) (Text.unpack -> text) = maybeToEither err $ readMaybe text+ where+ err =+ mconcat+ [ fn+ , ": expected one of "+ , List.intercalate ", " (show <$> [minBound @a .. maxBound])+ , " for "+ , what+ , ", but got "+ , text+ ]++set :: (a -> options -> options) -> Either String a -> Either String (Endo options)+set change = fmap $ Endo . change++lone :: [Pattern] -> Maybe SomeValue+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)+ | it `elem` ["true", "1"] = Right True+ | it `elem` ["false", "0"] = Right False+ | otherwise = Left $ "not a flag: " <> it
+ src/Language/Fluent/Locale.hs view
@@ -0,0 +1,43 @@+module Language.Fluent.Locale where++import Data.List.NonEmpty (NonEmpty)+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Time (UTCTime)+import Language.Fluent.Number (NumberOptions)+import Language.Fluent.Plural qualified as Plural+import Language.Fluent.Time (TimeOptions)+import Prelude++-- | A locale, identified by an implementation-defined code (e.g. BCP 47, ISO 639).+class Locale l where+ -- | Parse a locale from its textual code, if recognised.+ fromCode :: Text -> Maybe l++ -- | Render a locale back to its textual code.+ toCode :: l -> Text++ -- | Translate the name of one language into another.+ displayLanguage+ :: l+ -- ^ The language being named+ -> l+ -- ^ The language to render the name in+ -> Maybe Text++ -- | A language's own name for itself, e.g. "Deutsch" for German.+ localDisplayLanguage :: l -> Maybe Text+ localDisplayLanguage l = displayLanguage l l++ -- | Capitalise the first character of some text following the locale's casing rules.+ capitalise :: l -> Text -> Text++ -- | Classify a number into a plural category (e.g. "one", "few", "other"), used to+ -- pick the matching translation variant.+ pluralCategory :: l -> Scientific -> NumberOptions -> Plural.Category++ -- | Format a number according to locale conventions.+ formatNumber :: NonEmpty l -> Scientific -> NumberOptions -> Either String Text++ -- | Format a point in time according to locale conventions.+ formatTime :: NonEmpty l -> UTCTime -> TimeOptions -> Either String Text
+ src/Language/Fluent/Number.hs view
@@ -0,0 +1,139 @@+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
+ src/Language/Fluent/Pattern.hs view
@@ -0,0 +1,101 @@+module Language.Fluent.Pattern where++import Control.Monad.Extra (mconcatMapM)+import Data.Either (partitionEithers)+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+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.Number qualified as Number+import Language.Fluent.Value (CustomValue (..), SomeValue (..), Value (..))+import Text.Read (readMaybe)+import Prelude++-- | A t'AST.Pattern' with all the selections and interpolations resolved down to+-- t'SomeValue' 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+ | -- | A sequence of values surrounded by isolation marks (FSI, PDI).+ Isolated Pattern+ deriving stock (Show)++instance IsString Pattern where+ fromString = Pattern . pure . fromString++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++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++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 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 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++-- | 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)
+ src/Language/Fluent/Plural.hs view
@@ -0,0 +1,25 @@+-- | <https://www.unicode.org/reports/tr35/tr35-numbers.html#Language_Plural_Rules>+module Language.Fluent.Plural where++import Data.Char (toLower)+import Prelude++data Category+ = Zero+ | One+ | Two+ | Few+ | Many+ | Other+ deriving stock (Eq, Show, Bounded, Enum)++instance Read Category where+ readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], fmap toLower (show it) == fmap toLower s]++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]
+ src/Language/Fluent/Time.hs view
@@ -0,0 +1,99 @@+module Language.Fluent.Time where++import Data.Char (toLower)+import Data.Maybe (mapMaybe)+import Data.Text (Text)+import Data.Text qualified as Text+import Language.Fluent.Width (Width (..))+import Language.Fluent.Width qualified as Width+import Prelude++-- | How many digits a date or time field takes, e.g. the ninth month is+-- @9@ when 'Numeric' and @09@ when 'TwoDigit'.+data Digits = Numeric | TwoDigit+ deriving stock (Eq, Bounded, Enum)++instance Show Digits where+ show Numeric = "numeric"+ show TwoDigit = "2-digit"++instance Read Digits where+ readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], fmap toLower (show it) == fmap toLower s]++-- | <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl/DateTimeFormat/DateTimeFormat>+data TimeOptions = TimeOptions+ { timeZone :: Text+ , hour12 :: Maybe Bool+ , weekday :: Maybe Width+ , era :: Maybe Width+ , year :: Maybe Digits+ , month :: Maybe (Either Digits Width)+ , day :: Maybe Digits+ , hour :: Maybe Digits+ , minute :: Maybe Digits+ , second :: Maybe Digits+ , timeZoneName :: Maybe Width+ }+ deriving stock (Eq, Show)++timeOptions :: TimeOptions+timeOptions =+ TimeOptions+ { timeZone = "UTC"+ , hour12 = Nothing+ , weekday = Nothing+ , era = Nothing+ , year = Nothing+ , month = Nothing+ , day = Nothing+ , hour = Nothing+ , minute = Nothing+ , second = Nothing+ , timeZoneName = Nothing+ }++fields :: TimeOptions -> [(Char, Either Digits Width)]+fields options+ | null asked =+ fields+ options+ { year = Just Numeric+ , month = Just $ Left Numeric+ , day = Just Numeric+ }+ | otherwise = asked+ where+ asked =+ mapMaybe+ sequence+ [ ('G', Right <$> options.era)+ , ('y', Left <$> options.year)+ , ('M', options.month)+ , ('d', Left <$> options.day)+ , ('E', Right <$> options.weekday)+ , (hourSymbol, Left <$> options.hour)+ , ('m', Left <$> options.minute)+ , ('s', Left <$> options.second)+ , ('z', Right . zoneWidth <$> options.timeZoneName)+ ]+ zoneWidth Narrow = Short+ zoneWidth it = it++ hourSymbol :: Char+ hourSymbol = case options.hour12 of+ Nothing -> 'j'+ Just True -> 'h'+ Just False -> 'H'++skeleton :: TimeOptions -> Text+skeleton = Text.pack . foldMap symbol . fields+ where+ symbol :: (Char, Either Digits Width) -> String+ symbol (s, written) = replicate (letters written) s++letters :: Either Digits Width -> Int+letters = either digitsLetters Width.letters+ where+ digitsLetters :: Digits -> Int+ digitsLetters Numeric = 1+ digitsLetters TwoDigit = 2
+ src/Language/Fluent/Translate.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE RankNTypes #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-}++module Language.Fluent.Translate where++import Control.Applicative (optional)+import Data.Bifunctor (second)+import Data.Either.Extra (maybeToEither)+import Data.Foldable qualified as Foldable+import Data.Functor ((<&>))+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Traversable (for)+import Language.Fluent.AST (AttributeAccessor (..), Identifier)+import Language.Fluent.AST qualified as AST+import Language.Fluent.Bundle (Bundle (..))+import Language.Fluent.Bundle qualified as Bundle+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 Prelude++data Reference = Reference+ { name :: Either String Identifier+ , attribute :: Maybe AttributeAccessor+ , arguments :: HashMap Text SomeValue+ , overrides :: [Bundle.Override]+ }++instance IsString Reference where+ fromString s =+ Reference+ { name = fst <$> parsed+ , attribute = either (const Nothing) snd parsed+ , arguments = mempty+ , overrides = []+ }+ where+ parsed =+ Parser.parseNamed+ "reference"+ ((,) <$> Parser.identifier <*> optional Parser.attributeAccessor)+ (Text.pack s)++class Translate r where translate :: Reference -> r++instance (Locale locale) => Translate (Bundle locale -> Either String Text) where+ translate Reference{..} (flip (foldr Bundle.override) overrides -> bundle) = do+ name <- name+ message <- maybeToEither ("Message not found: " <> show name) $ Bundle.message name bundle+ pat <- case attribute of+ Nothing ->+ maybeToEither ("Message has no value: " <> show name) message.value+ Just (AttributeAccessor attribute) ->+ maybeToEither ("Attribute not found: " <> show attribute) $+ Pattern.attribute attribute message.attributes+ arguments <-+ HashMap.fromList <$> for (HashMap.toList arguments) \(k, v) ->+ Parser.parseIdentifier k <&> (,v)+ 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) =+ translate reference{arguments = HashMap.insert k v reference.arguments}++instance (Foldable f, k ~ Text, Value 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++instance (Translate r) => Translate (Bundle.Override -> r) where+ translate reference override = translate reference{overrides = override : reference.overrides}
+ src/Language/Fluent/Value.hs view
@@ -0,0 +1,63 @@+module Language.Fluent.Value where++import Data.List.NonEmpty (NonEmpty)+import Data.Scientific (Scientific, fromFloatDigits)+import Data.String (IsString (..))+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Time (UTCTime)+import Language.Fluent.Locale (Locale (..))+import Language.Fluent.Number (NumberOptions, numberOptions)+import Language.Fluent.Time (TimeOptions, timeOptions)+import Prelude++data CustomValue = forall v. (Value v) => CustomValue v++class Value v where+ value :: v -> SomeValue+ format :: (Locale l) => NonEmpty l -> v -> Either String Text+ format locale = format locale . value++data SomeValue+ = StringValue Text+ | NumberValue Scientific NumberOptions+ | TimeValue UTCTime TimeOptions+ | SomeValue CustomValue++instance Value Text where+ value = StringValue+ format _ = Right++instance Value String where value = StringValue . Text.pack++instance Value Scientific where value = flip NumberValue numberOptions++instance Value Int where value = value . fromIntegral @Int @Scientific++instance Value Integer where value = value . fromIntegral @Integer @Scientific++instance Value Word where value = value . fromIntegral @Word @Scientific++instance Value Double where value = value . fromFloatDigits++instance Value UTCTime where value = flip TimeValue timeOptions++instance Value CustomValue where+ value = SomeValue++ format locale (CustomValue v) = format locale v++instance IsString SomeValue where fromString = value++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 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
+ src/Language/Fluent/Width.hs view
@@ -0,0 +1,29 @@+module Language.Fluent.Width where++import Data.Char (toLower)+import Prelude++data Width+ = -- | e.g. @A@, @5s@+ Narrow+ | -- | e.g. @Aug@, @5 s@+ Short+ | -- | e.g. @August@, @5 seconds@+ Long+ deriving stock (Eq, Bounded, Enum)++instance Show Width where+ show Narrow = "narrow"+ show Short = "short"+ show Long = "long"++instance Read Width where+ readsPrec _ s = [(it, "") | it <- [minBound .. maxBound], 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.+-- See the <https://unicode.org/reports/tr35/tr35-dates.html#Date_Field_Symbol_Table Unicode date field symbol table>.+letters :: Width -> Int+letters Short = 3+letters Long = 4+letters Narrow = 5
+ test/ArgumentSpec.hs view
@@ -0,0 +1,32 @@+module ArgumentSpec (spec) where++import Prelude++spec :: Spec+spec = do+ it "is a text" $+ translate "foo" ("arg", "Bar" :: Text) [fluent|foo = { $arg }|] `shouldBe` Right "Bar"+ it "is a whole number" $+ translate "foo" ("arg", 3 :: Int) [fluent|foo = { $arg }|] `shouldBe` Right "3"+ 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"+ it "counts the way the locale counts" $+ translate+ "foo"+ ("n", 1 :: Int)+ [fluent|+ foo = { $n ->+ [one] one+ *[other] other+ }+ |]+ `shouldBe` Right "one"+ it "is one of several" $+ translate+ "foo"+ ("name", "Ann" :: Text)+ ("count", 2 :: Int)+ [fluent|foo = { $name } has { $count } messages|]+ `shouldBe` Right "Ann has 2 messages"
+ test/BuiltinSpec.hs view
@@ -0,0 +1,54 @@+module BuiltinSpec (spec) where++import Data.Foldable (for_)+import Data.Text qualified as Text+import Data.Time (UTCTime (..), fromGregorian, secondsToDiffTime)+import Prelude++spec :: Spec+spec = do+ describe "NUMBER" do+ 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 "selects by the plural category of the number" $+ withNumber+ [fluent|+ foo = { NUMBER($arg, minimumFractionDigits: 1) ->+ [one] one+ *[other] other+ }+ |]+ `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"++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
+ test/CycleSpec.hs view
@@ -0,0 +1,56 @@+module CycleSpec (spec) where++import Control.Exception (evaluate)+import System.Timeout (timeout)+import Prelude++spec :: Spec+spec = do+ it "is no circle where a message refers to an attribute of its own" $+ translate+ "foo"+ [fluent|+ foo = { foo.attr } and more+ .attr = Attribute+ |]+ `shouldBe` Right "Attribute and more"+ it "is no circle where a message refers to another one twice" $+ translate+ "foo"+ [fluent|+ bar = Bar+ foo = { bar } { bar }+ |]+ `shouldBe` Right "Bar Bar"+ it "answers when two messages refer to each other" $+ answers+ [fluent|+ foo = { bar }+ bar = { foo }+ |]+ it "answers when two terms refer to each other" $+ answers+ [fluent|+ -a = { -b }+ -b = { -a }+ foo = { -a }+ |]+ it "answers when a message refers to itself" $+ answers [fluent|foo = { foo }|]+ it "answers around a longer cycle" $+ answers+ [fluent|+ a = { b }+ b = { c }+ c = { a }+ foo = { a }+ |]++-- | Whether looking up @foo@ answers at all, one way or the other.+answers :: Resource -> Expectation+answers resource = do+ answered <- timeout 100000 . evaluate . length . show $ asked+ answered `shouldSatisfy` (/= Nothing)+ where+ asked :: Either String Text+ asked = translate "foo" resource
+ test/FunctionSpec.hs view
@@ -0,0 +1,124 @@+module FunctionSpec (spec) where++import Data.Either.Extra (maybeToEither)+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.Maybe (listToMaybe)+import Language.Fluent.Pattern qualified as Pattern+import Prelude++spec :: Spec+spec = do+ it "returns the first of its positional arguments" $+ translate+ "foo"+ ("a", "Foo" :: Text)+ ("b", "Bar" :: Text)+ (WithFunction "FIRST" first)+ [fluent|foo = { FIRST($a, $b) }|]+ `shouldBe` Right "Foo"+ it "is called with a named argument" $+ translate+ "foo"+ (WithFunction "PICK" pick)+ [fluent|foo = { PICK(which: "Bar") }|]+ `shouldBe` Right "Bar"+ it "is called with a named argument that is a number" $+ translate+ "foo"+ (WithFunction "PICK" pick)+ [fluent|foo = { PICK(which: 3) }|]+ `shouldBe` Right "3"+ it "is called with no arguments at all" $+ translate+ "foo"+ (WithFunction "GREET" greet)+ [fluent|foo = A{ GREET() }B|]+ `shouldBe` Right "AHelloB"+ it "is the selector of a select expression" $+ translate+ "foo"+ (WithFunction "PICK" pick)+ [fluent|+ foo = { PICK(which: "a") ->+ [a] A+ *[b] B+ }+ |]+ `shouldBe` Right "A"+ it "is called with a message reference" $+ translate+ "foo"+ (WithFunction "FIRST" first)+ [fluent|+ bar = Bar+ foo = { FIRST(bar) }+ |]+ `shouldBe` Right "Bar"+ it "is called with a message of more than one part" $+ translate+ "foo"+ (WithFunction "FIRST" first)+ [fluent|+ bar = B{ "a" }r+ foo = { FIRST(bar) }+ |]+ `shouldBe` Right "Bar"+ it "returns a variable, which a variant key still matches" $+ translate+ "foo"+ ("arg", "a" :: Text)+ (WithFunction "FIRST" first)+ [fluent|+ foo = { FIRST($arg) ->+ [a] A+ *[b] B+ }+ |]+ `shouldBe` Right "A"+ it "returns a message, which a variant key still matches" $+ translate+ "foo"+ (WithFunction "FIRST" first)+ [fluent|+ bar = a+ foo = { FIRST(bar) ->+ [a] A+ *[b] B+ }+ |]+ `shouldBe` Right "A"+ it "returns a message of more than one part, which cannot be a selector" $+ translate+ "foo"+ (WithFunction "FIRST" first)+ [fluent|+ bar = a{ "b" }+ foo = { FIRST(bar) ->+ [ab] AB+ *[c] C+ }+ |]+ `shouldBe` Left "Selector is not a number or identifier"+ it "is missing" $+ translate "foo" [fluent|foo = { MISSING() }|]+ `shouldBe` Left "Function not found: \"MISSING\""+ it "returns the reason it fails" $+ translate+ "foo"+ (WithFunction "FAIL" refuse)+ [fluent|foo = { FAIL() }|]+ `shouldBe` Left "this function always fails"++first :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern+first values _ = maybeToEither "no argument" $ listToMaybe values++greet :: [Pattern] -> HashMap Identifier SomeValue -> Either String Pattern+greet _ _ = Right "Hello"++pick :: [Pattern] -> HashMap Identifier SomeValue -> 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 _ _ = Left "this function always fails"
+ test/IsolationSpec.hs view
@@ -0,0 +1,48 @@+module IsolationSpec (spec) where++import Prelude++spec :: Spec+spec = do+ it "wraps a term reference" $+ translate+ "foo"+ (UseIsolating True)+ [fluent|+ -term = Term+ foo = a { -term } b+ |]+ `shouldBe` Right "a \8296Term\8297 b"+ it "wraps a message reference" $+ translate+ "foo"+ (UseIsolating True)+ [fluent|+ bar = Bar+ foo = a { bar } b+ |]+ `shouldBe` Right "a \8296Bar\8297 b"+ it "wraps a string literal" $+ translate "foo" (UseIsolating True) [fluent|foo = a { "Foo" } b|]+ `shouldBe` Right "a \8296Foo\8297 b"+ it "wraps a variable reference" $+ translate "foo" (UseIsolating True) ("arg", "Bar" :: Text) [fluent|foo = a { $arg } b|]+ `shouldBe` Right "a \8296Bar\8297 b"+ it "leaves a pattern of one element alone" $+ translate+ "foo"+ (UseIsolating True)+ [fluent|+ -term = Term+ foo = { -term }+ |]+ `shouldBe` Right "Term"+ it "is left out when the bundle turns it off" $+ translate+ "foo"+ (UseIsolating False)+ [fluent|+ -term = Term+ foo = a { -term } b+ |]+ `shouldBe` Right "a Term b"
+ test/LiteralSpec.hs view
@@ -0,0 +1,51 @@+module LiteralSpec (spec) where++import Prelude++spec :: Spec+spec = do+ describe "string" do+ it "is placed" $+ translate "foo" [fluent|foo = { "Foo" }|] `shouldBe` Right "Foo"+ it "may be empty" $+ translate "foo" [fluent|foo = A{ "" }B|] `shouldBe` Right "AB"+ it "keeps the whitespace inside it" $+ translate "foo" [fluent|foo = {" "}Foo|] `shouldBe` Right " Foo"+ it "escapes a quote" $+ translate "foo" [fluent|foo = { "\"" }|] `shouldBe` Right "\""+ it "escapes a backslash" $+ translate "foo" [fluent|foo = { "\\" }|] `shouldBe` Right "\\"+ it "escapes a character by its four digit code" $+ translate "foo" [fluent|foo = { "\u0041" }|] `shouldBe` Right "A"+ it "escapes a character by its six digit code" $+ translate "foo" [fluent|foo = { "\U01F602" }|] `shouldBe` Right "\128514"+ it "escapes a brace, which cannot be written on its own" $+ translate "foo" [fluent|foo = { "{" }Foo|] `shouldBe` Right "{Foo"++ describe "number" do+ it "is placed" $+ translate "foo" [fluent|foo = { 3 }|] `shouldBe` Right "3"+ it "is negative" $+ translate "foo" [fluent|foo = { -3 }|] `shouldBe` Right "-3"+ it "keeps the fraction digits it was written with" $+ 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"++ describe "placeable" do+ it "holds a placeable of its own" $+ translate "foo" [fluent|foo = { { 3 } }|] `shouldBe` Right "3"+ it "stands between texts" $+ translate "foo" [fluent|foo = Foo { "Bar" } Baz|] `shouldBe` Right "Foo Bar Baz"+ it "stands on a line of its own" $+ translate+ "foo"+ [fluent|+ foo =+ Foo+ { "Bar" }+ Baz+ |]+ `shouldBe` Right "Foo\nBar\nBaz"
+ test/Main.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/MessageSpec.hs view
@@ -0,0 +1,130 @@+module MessageSpec (spec) where++import Prelude++spec :: Spec+spec = do+ describe "value" do+ it "is the text after the equals sign" $+ translate "foo" [fluent|foo = Foo|] `shouldBe` Right "Foo"+ it "keeps the whitespace inside it" $+ translate "foo" [fluent|foo = Foo Bar|] `shouldBe` Right "Foo Bar"+ it "drops the whitespace around it" $+ translate "foo" [fluent|foo = Foo |] `shouldBe` Right "Foo"+ it "may be empty of everything but a placeable" $+ translate "foo" [fluent|foo = { "" }|] `shouldBe` Right ""+ it "is missing when the message only has attributes" $+ translate+ "foo"+ [fluent|+ foo =+ .attr = Attribute+ |]+ `shouldBe` Left "Message has no value: \"foo\""+ it "is missing when the message does not exist" $+ translate "bar" [fluent|foo = Foo|]+ `shouldBe` Left "Message not found: \"bar\""++ describe "attribute" do+ it "is the text after the equals sign" $+ translate+ "foo.attr"+ [fluent|+ foo = Foo+ .attr = Attribute+ |]+ `shouldBe` Right "Attribute"+ it "is one of several" $+ translate+ "foo.two"+ [fluent|+ foo = Foo+ .one = One+ .two = Two+ |]+ `shouldBe` Right "Two"+ it "belongs to a message without a value" $+ translate+ "foo.attr"+ [fluent|+ foo =+ .attr = Attribute+ |]+ `shouldBe` Right "Attribute"+ it "is missing when the message does not have it" $+ translate "foo.attr" [fluent|foo = Foo|]+ `shouldBe` Left "Attribute not found: \"attr\""++ describe "identifier" do+ it "holds letters, digits, dashes and underscores" $+ translate "foo-bar_1" [fluent|foo-bar_1 = Ok|] `shouldBe` Right "Ok"+ it "cannot hold a space in a reference" $+ translate "not a name" [fluent|foo = Foo|]+ `shouldBe` Left "Invalid reference: \"not a name\""+ it "cannot hold a space in an argument name" $+ translate "foo" ("not a name", "Bar" :: Text) [fluent|foo = { $arg }|]+ `shouldBe` Left "Invalid identifier: \"not a name\""+ it "keeps the first message when reused" $+ translate+ "foo"+ [fluent|+ foo = First+ foo = Second+ |]+ `shouldBe` Right "First"++ describe "several lines" do+ it "are joined by the line breaks between them" $+ translate+ "foo"+ [fluent|+ foo =+ Foo+ Bar+ |]+ `shouldBe` Right "Foo\nBar"+ it "lose the indent they share" $+ translate+ "foo"+ [fluent|+ foo =+ Foo+ Bar+ |]+ `shouldBe` Right "Foo\n Bar"+ it "keep the blank lines between them" $+ translate+ "foo"+ [fluent|+ foo =+ Foo++ Bar+ |]+ `shouldBe` Right "Foo\n\nBar"+ it "may start on the line of the identifier" $+ translate+ "foo"+ [fluent|+ foo = Foo+ Bar+ |]+ `shouldBe` Right "Foo\nBar"+ it "may begin with a placeable, which begins no line of its own" $+ translate+ "foo"+ [fluent|+ foo =+ { "Bar" }+ Baz+ |]+ `shouldBe` Right "Bar\nBaz"+ it "may hold a placeable of their own" $+ translate+ "foo"+ [fluent|+ foo =+ Foo+ { "Bar" }+ |]+ `shouldBe` Right "Foo\nBar"
+ test/Prelude.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Prelude+ ( module Prelude+ , module Data.Scientific+ , module Data.Text+ , module Language.Fluent+ , module Test.Hspec+ )+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.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++instance (r ~ Either String Text) => Translate (Resource -> r) where+ translate reference =+ translate reference+ . Bundle.override (Bundle.UseIsolating False)+ . bundle (pure Plain)+ . pure
+ test/ReferenceSpec.hs view
@@ -0,0 +1,129 @@+module ReferenceSpec (spec) where++import Prelude++spec :: Spec+spec = do+ describe "message" do+ it "stands for its value" $+ translate+ "bar"+ [fluent|+ foo = Foo+ bar = { foo } Bar+ |]+ `shouldBe` Right "Foo Bar"+ it "stands for one of its attributes" $+ translate+ "bar"+ [fluent|+ foo = Foo+ .attr = Attribute+ bar = { foo.attr }+ |]+ `shouldBe` Right "Attribute"+ it "passes its arguments on" $+ translate+ "bar"+ ("arg", "Bar" :: Text)+ [fluent|+ foo = { $arg }+ bar = { foo }+ |]+ `shouldBe` Right "Bar"+ it "reaches through a chain of references" $+ translate+ "baz"+ [fluent|+ foo = Foo+ bar = { foo }+ baz = { bar }+ |]+ `shouldBe` Right "Foo"+ it "is missing" $+ translate "bar" [fluent|bar = { foo }|]+ `shouldBe` Left "Message not found: foo"+ it "has no value of its own" $+ translate+ "bar"+ [fluent|+ foo =+ .attr = Attribute+ bar = { foo }+ |]+ `shouldBe` Left "Message has no value: \"foo\""+ it "has no such attribute" $+ translate+ "bar"+ [fluent|+ foo = Foo+ bar = { foo.attr }+ |]+ `shouldBe` Left "Attribute not found: (\"foo\",\"attr\")"++ describe "term" do+ it "stands for its value" $+ translate+ "foo"+ [fluent|+ -term = Term+ foo = { -term } Foo+ |]+ `shouldBe` Right "Term Foo"+ it "chooses a variant by one of its attributes" $+ translate+ "foo"+ [fluent|+ -term = Term+ .attr = key+ foo = { -term.attr ->+ *[key] Attribute+ }+ |]+ `shouldBe` Right "Attribute"+ it "takes arguments of its own" $+ translate "genitive" brand `shouldBe` Right "Firefox's feature"+ it "matches a variant key by the argument it is given" $+ translate+ "foo"+ [fluent|+ -brand = { $case ->+ [genitive] Firefox's+ *[nominative] Firefox+ }+ foo = { -brand(case: "genitive") } feature+ |]+ `shouldBe` Right "Firefox's feature"+ it "falls back to its default without arguments" $+ translate "plain" brand `shouldBe` Right "Firefox feature"+ it "cannot be reached as a message" $+ translate+ "foo"+ [fluent|+ -term = Term+ foo = { term }+ |]+ `shouldBe` Left "Message not found: term"+ it "does not read the arguments of the message that refers to it" $+ translate+ "foo"+ ("arg", "Bar" :: Text)+ [fluent|+ -term = { $arg }+ foo = { -term }+ |]+ `shouldBe` Left "Variable not found: \"arg\""+ it "is missing" $+ translate "foo" [fluent|foo = { -term }|]+ `shouldBe` Left "Term not found: \"term\""++brand :: Resource+brand =+ [fluent|+ -brand = { $case ->+ [genitive] Firefox's+ *[nominative] Firefox+ }+ genitive = { -brand(case: "genitive") } feature+ plain = { -brand } feature+ |]
+ test/SelectSpec.hs view
@@ -0,0 +1,152 @@+module SelectSpec (spec) where++import Prelude++spec :: Spec+spec = do+ it "picks the variant whose key matches" $+ translate "foo" ("arg", "a" :: Text) letters `shouldBe` Right "A"+ it "picks the default variant when no key matches" $+ translate "foo" ("arg", "c" :: Text) letters `shouldBe` Right "B"+ it "picks the default variant when the selector is missing" $+ translate "foo" letters `shouldBe` Right "B"+ it "picks the variant whose number key matches" $+ translate "foo" ("arg", 1 :: Int) numbers `shouldBe` Right "One"+ it "picks a number key over a category" $+ translate "foo" ("arg", 0 :: Int) numbers `shouldBe` Right "Zero"+ it "picks an exact key over a category that is written before it" $+ translate+ "foo"+ ("arg", 0 :: Int)+ [fluent|+ foo = { $arg ->+ *[other] Other+ [0] Zero+ }+ |]+ `shouldBe` Right "Zero"+ 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" $+ translate+ "foo"+ ("outer", "x" :: Text)+ ("inner", "y" :: Text)+ [fluent|+ foo = { $outer ->+ [x] { $inner ->+ [y] XY+ *[z] XZ+ }+ *[o] O+ }+ |]+ `shouldBe` Right "XY"+ it "counts a number that is below zero by how far it is from it" $+ translate+ "foo"+ ("n", -1 :: Int)+ [fluent|+ foo = { $n ->+ [one] one+ *[other] other+ }+ |]+ `shouldBe` Right "one"+ it "cannot select on a value of several parts" $+ translate+ "foo"+ [fluent|+ -term = Term+ .attr = a{ "b" }+ foo = { -term.attr ->+ [ab] AB+ *[c] C+ }+ |]+ `shouldBe` Left "Selector is not a number or identifier"+ it "selects on a string literal" $+ translate+ "foo"+ [fluent|+ foo = { "a" ->+ [a] A+ *[b] B+ }+ |]+ `shouldBe` Right "A"+ it "selects on a number literal" $+ translate+ "foo"+ [fluent|+ foo = { 1 ->+ [1] One+ *[other] Other+ }+ |]+ `shouldBe` Right "One"+ it "selects on an attribute of a term" $+ translate+ "foo"+ [fluent|+ -term = Term+ .gender = feminine+ foo = { -term.gender ->+ [feminine] She+ *[masculine] He+ }+ |]+ `shouldBe` Right "She"+ it "holds a placeable in the variant it picks" $+ translate+ "foo"+ ("arg", "a" :: Text)+ [fluent|+ foo = { $arg ->+ [a] A { $arg }+ *[b] B+ }+ |]+ `shouldBe` Right "A a"+ it "holds several lines in the variant it picks" $+ translate+ "foo"+ [fluent|+ foo = { "a" ->+ [a]+ One+ Two+ *[b] B+ }+ |]+ `shouldBe` Right "One\nTwo"+ it "stands between texts" $+ translate+ "foo"+ ("arg", "a" :: Text)+ [fluent|+ foo = Foo { $arg ->+ [a] A+ *[b] B+ } Baz+ |]+ `shouldBe` Right "Foo A Baz"++letters :: Resource+letters =+ [fluent|+ foo = { $arg ->+ [a] A+ *[b] B+ }+ |]++numbers :: Resource+numbers =+ [fluent|+ foo = { $arg ->+ [0] Zero+ [1] One+ *[other] Other+ }+ |]
+ test/VariableSpec.hs view
@@ -0,0 +1,35 @@+module VariableSpec (spec) where++import Prelude++spec :: Spec+spec = do+ it "is a string" $+ translate "foo" ("arg", "Bar" :: Text) [fluent|foo = { $arg }|]+ `shouldBe` Right "Bar"+ it "is a number" $+ translate "foo" ("arg", 3 :: Int) [fluent|foo = { $arg }|]+ `shouldBe` Right "3"+ it "stands between texts" $+ translate "foo" ("arg", "Bar" :: Text) [fluent|foo = Foo { $arg } Baz|]+ `shouldBe` Right "Foo Bar Baz"+ it "stands more than once" $+ translate "foo" ("arg", "Ha" :: Text) [fluent|foo = { $arg }{ $arg }|]+ `shouldBe` Right "HaHa"+ it "shows as many fraction digits as the number holds" $+ translate+ "foo"+ ("arg", NumberValue 1 numberOptions{minimumFractionDigits = 2})+ [fluent|foo = { $arg }|]+ `shouldBe` Right "1.00"+ it "is missing" $+ translate "foo" [fluent|foo = { $arg }|]+ `shouldBe` Left "Variable not found: \"arg\""+ it "is missing only where it is used" $+ translate+ "foo"+ [fluent|+ foo = Foo+ bar = { $arg }+ |]+ `shouldBe` Right "Foo"