diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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. diff --git a/LICENCE b/LICENCE new file mode 100644 --- /dev/null +++ b/LICENCE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/fluent.cabal b/fluent.cabal new file mode 100644 --- /dev/null +++ b/fluent.cabal @@ -0,0 +1,126 @@ +cabal-version: 3.0 +name: fluent +version: 1.0.0 +synopsis: Haskell implementation of Project Fluent +description: + This library implements , + 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, diff --git a/src/Language/Fluent.hs b/src/Language/Fluent.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE Trustworthy #-} + +-- | +-- Module : Language.Fluent +-- Copyright : (c) 2026 Institute for Digital Autonomy +-- License : EUPL-1.2 +-- Maintainer : IDA +-- +-- 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: +-- +-- * , +-- backed by +-- * , +-- 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 (..)) diff --git a/src/Language/Fluent/Bundle.hs b/src/Language/Fluent/Bundle.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Bundle.hs @@ -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 diff --git a/src/Language/Fluent/Function.hs b/src/Language/Fluent/Function.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Function.hs @@ -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 diff --git a/src/Language/Fluent/Locale.hs b/src/Language/Fluent/Locale.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Locale.hs @@ -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 diff --git a/src/Language/Fluent/Number.hs b/src/Language/Fluent/Number.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Number.hs @@ -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 + -- code: @Currency "EUR"@ gives @€12.50@ + Currency Text + | -- | A measurement in the given + -- : + -- @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] + +-- | +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" + +-- | +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 diff --git a/src/Language/Fluent/Pattern.hs b/src/Language/Fluent/Pattern.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Pattern.hs @@ -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) diff --git a/src/Language/Fluent/Plural.hs b/src/Language/Fluent/Plural.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Plural.hs @@ -0,0 +1,25 @@ +-- | +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] diff --git a/src/Language/Fluent/Time.hs b/src/Language/Fluent/Time.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Time.hs @@ -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] + +-- | +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 diff --git a/src/Language/Fluent/Translate.hs b/src/Language/Fluent/Translate.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Translate.hs @@ -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} diff --git a/src/Language/Fluent/Value.hs b/src/Language/Fluent/Value.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Value.hs @@ -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 diff --git a/src/Language/Fluent/Width.hs b/src/Language/Fluent/Width.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/Width.hs @@ -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 . +letters :: Width -> Int +letters Short = 3 +letters Long = 4 +letters Narrow = 5 diff --git a/test/ArgumentSpec.hs b/test/ArgumentSpec.hs new file mode 100644 --- /dev/null +++ b/test/ArgumentSpec.hs @@ -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" diff --git a/test/BuiltinSpec.hs b/test/BuiltinSpec.hs new file mode 100644 --- /dev/null +++ b/test/BuiltinSpec.hs @@ -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 diff --git a/test/CycleSpec.hs b/test/CycleSpec.hs new file mode 100644 --- /dev/null +++ b/test/CycleSpec.hs @@ -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 diff --git a/test/FunctionSpec.hs b/test/FunctionSpec.hs new file mode 100644 --- /dev/null +++ b/test/FunctionSpec.hs @@ -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" diff --git a/test/IsolationSpec.hs b/test/IsolationSpec.hs new file mode 100644 --- /dev/null +++ b/test/IsolationSpec.hs @@ -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" diff --git a/test/LiteralSpec.hs b/test/LiteralSpec.hs new file mode 100644 --- /dev/null +++ b/test/LiteralSpec.hs @@ -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" diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/MessageSpec.hs b/test/MessageSpec.hs new file mode 100644 --- /dev/null +++ b/test/MessageSpec.hs @@ -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" diff --git a/test/Prelude.hs b/test/Prelude.hs new file mode 100644 --- /dev/null +++ b/test/Prelude.hs @@ -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 diff --git a/test/ReferenceSpec.hs b/test/ReferenceSpec.hs new file mode 100644 --- /dev/null +++ b/test/ReferenceSpec.hs @@ -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 + |] diff --git a/test/SelectSpec.hs b/test/SelectSpec.hs new file mode 100644 --- /dev/null +++ b/test/SelectSpec.hs @@ -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 + } + |] diff --git a/test/VariableSpec.hs b/test/VariableSpec.hs new file mode 100644 --- /dev/null +++ b/test/VariableSpec.hs @@ -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"