fluent-icu (empty) → 1.0.0
raw patch · 13 files changed
+1331/−0 lines, 13 filesdep +basedep +bytestringdep +fluentsetup-changed
Dependencies added: base, bytestring, fluent, fluent-icu, hspec, scientific, text, text-icu, time
Files
- CHANGELOG.md +12/−0
- LICENCE +287/−0
- Setup.hs +2/−0
- cbits.c +274/−0
- fluent-icu.cabal +85/−0
- src/Language/Fluent/ICU.hs +293/−0
- test/BuiltinSpec.hs +76/−0
- test/LocaleSpec.hs +12/−0
- test/NumberSpec.hs +102/−0
- test/PluralSpec.hs +72/−0
- test/Prelude.hs +51/−0
- test/Spec.hs +1/−0
- test/TimeSpec.hs +64/−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
+ cbits.c view
@@ -0,0 +1,274 @@+#include <string.h>++#include <unicode/stringoptions.h>+#include <unicode/ucal.h>+#include <unicode/ucasemap.h>+#include <unicode/udatpg.h>+#include <unicode/uformattednumber.h>+#include <unicode/uformattedvalue.h>+#include <unicode/uloc.h>+#include <unicode/unumberformatter.h>+#include <unicode/upluralrules.h>+#include <unicode/ustring.h>++/*+ * Retrieve the localised display name of a locale translated into the display locale.+ */+int32_t fluent_get_display_language(+ char const* locale, char const* displayLocale, char* name, int32_t capacity)+{+ if (name == NULL || capacity <= 0) return -1;++ UErrorCode status = U_ZERO_ERROR;+ UChar display[256];+ int32_t length = uloc_getDisplayLanguage(locale, displayLocale, display, 256, &status);+ if (U_FAILURE(status) || status == U_USING_DEFAULT_WARNING) return -1;++ int32_t written = 0;+ u_strToUTF8(name, capacity, &written, display, length, &status);+ if (U_FAILURE(status)) return -1;+ return written;+}++/*+ * Apply title-casing to a UTF-8 string according to the rules of the given locale.+ * Existing casing isn't overwritten where inappropriate.+ */+int32_t fluent_format_titlecase(+ char const* locale, char const* text, int32_t textLength, char* capitalised, int32_t capacity)+{+ if (capitalised == NULL || capacity <= 0) return -1;++ UErrorCode status = U_ZERO_ERROR;+ UCaseMap* caseMap =+ ucasemap_open(locale, U_TITLECASE_SENTENCES | U_TITLECASE_NO_LOWERCASE, &status);+ if (U_FAILURE(status)) {+ if (caseMap != NULL) ucasemap_close(caseMap);+ return -1;+ }++ int32_t written =+ ucasemap_utf8ToTitle(caseMap, capitalised, capacity, text, textLength, &status);+ ucasemap_close(caseMap);+ if (U_FAILURE(status)) return -1;+ return written;+}++/*+ * Format an exact decimal string according to an ICU number skeleton and locale.+ * The caller owns the returned object and must release it with unumf_closeResult().+ * Returns NULL on failure, with the reason written to *status.+ */+static UFormattedNumber* fluent_format_decimal_number(char const* locale, char const* skeleton,+ char const* decimal, int32_t decimalLength, UErrorCode* status)+{+ UChar wantedSkeleton[128];+ int32_t skeletonLength = 0;+ u_strFromUTF8(wantedSkeleton, 128, &skeletonLength, skeleton, -1, status);+ if (U_FAILURE(*status)) return NULL;++ UNumberFormatter* formatter =+ unumf_openForSkeletonAndLocale(wantedSkeleton, skeletonLength, locale, status);+ if (U_FAILURE(*status)) {+ if (formatter != NULL) unumf_close(formatter);+ return NULL;+ }++ UFormattedNumber* result = unumf_openResult(status);+ if (U_FAILURE(*status)) {+ unumf_close(formatter);+ if (result != NULL) unumf_closeResult(result);+ return NULL;+ }++ unumf_formatDecimal(formatter, decimal, decimalLength, result, status);+ unumf_close(formatter);+ if (U_FAILURE(*status)) {+ unumf_closeResult(result);+ return NULL;+ }++ return result;+}++/*+ * Format an exact decimal string according to an ICU number skeleton and locale.+ * On failure, returns the negated UErrorCode (see u_errorName()), never 0 or a positive number.+ */+int32_t fluent_format_decimal(char const* locale, char const* skeleton, char const* decimal,+ int32_t decimalLength, char* formatted, int32_t capacity)+{+ if (formatted == NULL || capacity <= 0) return -U_ILLEGAL_ARGUMENT_ERROR;++ UErrorCode status = U_ZERO_ERROR;+ UFormattedNumber* result =+ fluent_format_decimal_number(locale, skeleton, decimal, decimalLength, &status);+ if (result == NULL) return -(int32_t) status;++ UFormattedValue const* value = unumf_resultAsValue(result, &status);+ int32_t length = 0;+ UChar const* text = ufmtval_getString(value, &length, &status);++ int32_t written = 0;+ u_strToUTF8(formatted, capacity, &written, text, length, &status);+ unumf_closeResult(result);+ if (U_FAILURE(status)) return -(int32_t) status;+ return written;+}++/*+ * Determine the plural category keyword ("zero", "one", "two", "few", "many", "other") for+ * an exact decimal value, formatted per the given number skeleton, in a given locale.+ * Supports both cardinal and ordinal rules.+ * On failure, returns the negated UErrorCode (see u_errorName()), never 0 or a positive number.+ */+int32_t fluent_get_plural_keyword(char const* locale, int ordinal, char const* skeleton,+ char const* decimal, int32_t decimalLength, char* keyword, int32_t capacity)+{+ if (keyword == NULL || capacity <= 0) return -U_ILLEGAL_ARGUMENT_ERROR;++ UErrorCode status = U_ZERO_ERROR;+ UFormattedNumber* result =+ fluent_format_decimal_number(locale, skeleton, decimal, decimalLength, &status);+ if (result == NULL) return -(int32_t) status;++ UPluralRules* rules = uplrules_openForType(+ locale, ordinal ? UPLURAL_TYPE_ORDINAL : UPLURAL_TYPE_CARDINAL, &status);+ if (U_FAILURE(status)) {+ if (rules != NULL) uplrules_close(rules);+ unumf_closeResult(result);+ return -(int32_t) status;+ }++ UChar selected[32];+ int32_t length = uplrules_selectFormatted(rules, result, selected, 32, &status);+ uplrules_close(rules);+ unumf_closeResult(result);+ if (U_FAILURE(status)) return -(int32_t) status;++ int32_t written = 0;+ u_strToUTF8(keyword, capacity, &written, selected, length, &status);+ if (U_FAILURE(status)) return -(int32_t) status;+ return written;+}++/*+ * Resolve a date/time format skeleton (e.g., "yMMMd") into a localised+ * concrete pattern string (e.g., "d MMM y") tailored to the requested locale.+ */+int32_t fluent_resolve_date_pattern(+ char const* locale, char const* skeleton, char* pattern, int32_t capacity)+{+ if (pattern == NULL || capacity <= 0) return -1;++ UErrorCode status = U_ZERO_ERROR;+ UDateTimePatternGenerator* generator = udatpg_open(locale, &status);+ if (U_FAILURE(status)) {+ if (generator != NULL) udatpg_close(generator);+ return -1;+ }++ UChar wanted[64];+ int32_t wantedLength = 0;+ u_strFromUTF8(wanted, 64, &wantedLength, skeleton, -1, &status);+ if (U_FAILURE(status)) {+ udatpg_close(generator);+ return -1;+ }++ UChar best[256];+ int32_t length = udatpg_getBestPattern(generator, wanted, wantedLength, best, 256, &status);+ udatpg_close(generator);+ if (U_FAILURE(status)) return -1;++ int32_t written = 0;+ u_strToUTF8(pattern, capacity, &written, best, length, &status);+ if (U_FAILURE(status)) return -1;+ return written;+}++/*+ * Set the time of an calendar to the specified milliseconds since the Unix epoch.+ */+int32_t fluent_set_calendar_time_ms(UCalendar* calendar, double millis)+{+ if (calendar == NULL) return -1;++ UErrorCode status = U_ZERO_ERROR;+ ucal_setMillis(calendar, millis, &status);+ if (U_FAILURE(status)) return -1;+ return 0;+}++/*+ * The name of an ICU error code (e.g. "U_ILLEGAL_ARGUMENT_ERROR"), as named by u_errorName().+ * The returned string is static and owned by ICU.+ */+char const* fluent_error_name(int32_t code) { return u_errorName((UErrorCode) code); }++/*+ * Determine whether a given locale string is known to ICU.+ */+static UBool fluent_locale_is_available(char const* candidate)+{+ // Binary search assumes that locales returned by uloc_getAvailable are sorted.+ int32_t low = 0;+ int32_t high = uloc_countAvailable() - 1;+ while (low <= high) {+ int32_t mid = low + (high - low) / 2;+ int cmp = strcmp(candidate, uloc_getAvailable(mid));+ if (cmp == 0) return 1;+ if (cmp < 0)+ high = mid - 1;+ else+ low = mid + 1;+ }+ return 0;+}++/*+ * Walk up the BCP 47 locale hierarchy (e.g., de-CH -> de) to find the most specific+ * ancestor that ICU has data for.+ * Matches Intl (ECMA-402) locale-list resolution semantics.+ * Returns -1 if the root is reached without a match.+ */+static int32_t fluent_lookup_locale(char const* start, char* negotiated, int32_t capacity)+{+ UErrorCode status = U_ZERO_ERROR;+ char current[ULOC_FULLNAME_CAPACITY];+ int32_t currentLength = uloc_canonicalize(start, current, ULOC_FULLNAME_CAPACITY, &status);+ if (U_FAILURE(status)) return -1;++ for (;;) {+ if (fluent_locale_is_available(current)) {+ if (currentLength >= capacity) return -1;+ memcpy(negotiated, current, (size_t) currentLength + 1);+ return currentLength;+ }+ if (currentLength == 0) return -1;++ UErrorCode parentStatus = U_ZERO_ERROR;+ char parent[ULOC_FULLNAME_CAPACITY];+ currentLength = uloc_getParent(current, parent, ULOC_FULLNAME_CAPACITY, &parentStatus);+ if (U_FAILURE(parentStatus)) return -1;+ memcpy(current, parent, ULOC_FULLNAME_CAPACITY);+ }+}++/* Negotiate a BCP 47-style locale preference list against the locales ICU has data for,+ * trying each preference's ancestor chain (see fluent_lookup_locale) and taking the first one+ * with any match at all.+ * A NULL entry in `preferences` (Haskell's `Current`) represents ICU's default locale.+ */+int32_t fluent_negotiate_supported_locale(+ char const** preferences, int32_t preferenceCount, char* negotiated, int32_t capacity)+{+ if (negotiated == NULL || capacity <= 0) return -1;++ int32_t written = -1;+ for (int32_t i = 0; i < preferenceCount && written < 0; ++i) {+ written = fluent_lookup_locale(+ preferences[i] ? preferences[i] : uloc_getDefault(), negotiated, capacity);+ }+ return written;+}
+ fluent-icu.cabal view
@@ -0,0 +1,85 @@+cabal-version: 3.0+name: fluent-icu+version: 1.0.0+synopsis: ICU backend for fluent+description: ICU backend for <https://hackage.haskell.org/package/fluent fluent>.+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+ ghc-options:+ -Weverything+ -Wno-safe+ -Wno-unsafe+ -Wno-all-missed-specialisations+ -Wno-missing-export-lists+ -Wno-missing-import-lists+ -Wno-missing-kind-signatures+ -Wno-missing-role-annotations+ -Wno-missing-safe-haskell-mode+ -Wno-orphans++ default-extensions:+ BlockArguments+ FlexibleInstances+ ImportQualifiedPost+ LambdaCase+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedRecordDot+ OverloadedStrings+ QuasiQuotes+ RecordWildCards+ TypeApplications+ TypeOperators+ ViewPatterns++ build-depends:+ base >=4.11 && <5,+ fluent >=1.0 && <1.1,+ text >=2.0 && <2.2,++library+ import: common+ hs-source-dirs: src+ build-depends:+ bytestring >=0.11 && <0.13,+ scientific >=0.3 && <0.4,+ text-icu >=0.8 && <0.9,+ time >=1.12 && <1.17,++ c-sources: cbits.c+ pkgconfig-depends:+ icu-i18n,+ icu-uc,++ exposed-modules:+ Language.Fluent.ICU++test-suite test+ import: common+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules:+ BuiltinSpec+ LocaleSpec+ NumberSpec+ PluralSpec+ Prelude+ TimeSpec++ build-depends:+ fluent-icu,+ hspec >=2.11 && <2.12,+ scientific >=0.3 && <0.4,+ time >=1.12 && <1.17,
+ src/Language/Fluent/ICU.hs view
@@ -0,0 +1,293 @@+{-# LANGUAGE Trustworthy #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-}++-- |+-- Module : Language.Fluent.ICU+-- Copyright : (c) 2026 Institute for Digital Autonomy+-- License : EUPL-1.2+-- Maintainer : IDA+--+-- <https://projectfluent.org Project Fluent> localisation backed by+-- <https://unicode-org.github.io/icu/ ICU> using the+-- <https://hackage.package.org/package/text-icu text-icu> library.+--+-- This module re-exports everything needed to translate Fluent messages.+--+-- = Quickstart+--+-- == 1. Parsing resources+--+-- Embed Fluent resources at compile time using the 'fluent' quasi-quoter:+--+-- >>> :{+-- let resource =+-- [fluent|+-- welcome = Welcome back!+-- greeting = Hello, { $name }! You have { $count } new messages.+-- unread-emails =+-- { $count ->+-- [one] You have one unread email.+-- *[other] You have several unread emails.+-- }+-- amount = { $amount }+-- price = { NUMBER($amount, currency: "EUR", currencyDisplay: "name") }+-- temperature = { NUMBER($degrees, unit: "celsius", unitDisplay: "long") }+-- |]+-- :}+--+-- Or parse Fluent source at runtime with 'parseResource':+--+-- > resource <- either fail pure . parseResource =<< Text.readFile "resource.ftl"+--+-- == 2. Building bundles+--+-- Combine 'Resource's and 'Locale's into a 'Bundle' using 'bundle':+--+-- >>> let english = bundle @LocaleName (pure "en-GB") [resource]+-- >>> let german = bundle @LocaleName (pure "de-CH") [resource]+--+-- == 3. Translating messages+--+-- Translate messages with 'translate':+--+-- >>> translate "welcome" english :: Either String Text+-- Right "Welcome back!"+--+-- Pass parameters as name-value tuples:+--+-- >>> translate "unread-emails" ("count", value @Int 1) english :: Either String Text+-- Right "You have one unread email."+-- >>> translate "unread-emails" ("count", value @Int 5) english :: Either String Text+-- Right "You have several unread emails."+--+-- You can chain multiple arguments and configure Unicode isolation marks using 'UseIsolating':+--+-- >>> translate "greeting" ("name", value @Text "Ann") ("count", value @Int 3) (UseIsolating False) english :: Either String Text+-- Right "Hello, Ann! You have 3 new messages."+--+-- == 4. Formatting numbers, currencies, and units+--+-- Number formatting adapts to the target locale:+--+-- >>> translate "amount" ("amount", value @Int 1234567) english :: Either String Text+-- Right "1,234,567"+-- >>> translate "amount" ("amount", value @Int 1234567) german :: Either String Text+-- Right "1'234'567"+-- >>> translate "price" ("amount", value @Double 1234.5) english :: Either String Text+-- Right "1,234.50 euros"+-- >>> translate "price" ("amount", value @Double 1234.5) german :: Either String Text+-- Right "1'234.50 Euro"+-- >>> translate "temperature" ("degrees", value @Int 21) english :: Either String Text+-- Right "21 degrees Celsius"+-- >>> translate "temperature" ("degrees", value @Int 21) german :: Either String Text+-- Right "21 Grad Celsius"+--+-- You can pass formatting options directly via structured values:+--+-- >>> translate "amount" ("amount", NumberValue 1234.5 numberOptions{style = Currency "EUR", currencyDisplay = Name}) english :: Either String Text+-- Right "1,234.50 euros"+-- >>> translate "amount" ("amount", NumberValue 21 numberOptions{style = Unit "metre-per-second", unitDisplay = Short}) english :: Either String Text+-- Right "21 m/s"+module Language.Fluent.ICU+ ( -- * Re-exports+ module Data.Text.ICU+ , module Language.Fluent+ )+where++import Control.Exception (SomeException, evaluate, try)+import Control.Monad (when)+import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.List.NonEmpty (NonEmpty (..))+import Data.List.NonEmpty qualified as NonEmpty+import Data.Maybe (fromMaybe)+import Data.Scientific (FPFormat (Fixed), Scientific, formatScientific)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text+import Data.Text.ICU (LocaleName (..))+import Data.Text.ICU.Calendar (Calendar)+import Data.Text.ICU.Calendar qualified as ICU+import Data.Text.ICU.DateFormatter qualified as ICU+import Data.Text.ICU.Types qualified as ICU+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import Foreign.C.String (CString, peekCString, peekCStringLen, withCString)+import Foreign.C.Types (CDouble (..), CInt (..))+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Marshal.Array (withArrayLen)+import Foreign.Marshal.Utils (withMany)+import Foreign.Ptr (Ptr, nullPtr)+import Language.Fluent+import Language.Fluent.Number qualified as Number+import Language.Fluent.Plural qualified as Plural+import Language.Fluent.Time qualified as Time+import System.IO.Unsafe (unsafePerformIO)+import Text.Read (readMaybe)+import Prelude++instance Locale LocaleName where+ fromCode = negotiateLocale . pure . ICU.Locale . Text.unpack++ toCode (ICU.Locale name) = Text.pack name+ toCode _ = ""++ displayLanguage a b = unsafePerformIO $+ withLocaleName a \source ->+ withLocaleName b \target ->+ allocaBytes capacity \name -> do+ written <- fluentGetDisplayLanguage source target name (fromIntegral capacity)+ if written < 0+ then pure Nothing+ else Just . Text.decodeUtf8 <$> ByteString.packCStringLen (name, fromIntegral written)+ where+ capacity = 256 :: Int++ capitalise l text = unsafePerformIO $+ withLocaleName l \locale ->+ ByteString.useAsCStringLen utf8 \(source, sourceLength) ->+ allocaBytes capacity \out -> do+ written <-+ fluentFormatTitlecase locale source (fromIntegral sourceLength) out (fromIntegral capacity)+ if written < 0+ then pure text+ else Text.decodeUtf8 <$> ByteString.packCStringLen (out, fromIntegral written)+ where+ utf8 = Text.encodeUtf8 text+ capacity = 2 * ByteString.length utf8 + 16++ pluralCategory locale value options = unsafePerformIO $+ withLocaleName locale \name ->+ withUtf8Text (Number.skeleton options) \skeleton ->+ ByteString.useAsCStringLen (exactDecimal value) \(decimal, decimalLength) ->+ allocaBytes capacity \keyword -> do+ written <-+ fluentGetPluralKeyword+ name+ ordinal+ skeleton+ decimal+ (fromIntegral decimalLength)+ keyword+ (fromIntegral capacity)+ if written < 0+ then pure Plural.Other+ else fromMaybe Plural.Other . readMaybe <$> peekCStringLen (keyword, fromIntegral written)+ where+ capacity = 32 :: Int+ ordinal = case options.form of+ Plural.Cardinal -> 0 :: CInt+ Plural.Ordinal -> 1++ formatNumber locales value options = unsafePerformIO $+ withLocaleName locale \name ->+ withUtf8Text skeleton \skel ->+ ByteString.useAsCStringLen (exactDecimal value) \(decimal, decimalLength) ->+ let capacity = max 256 $ decimalLength * 2 + 64+ in allocaBytes capacity \out -> do+ written <-+ fluentFormatDecimal+ name+ skel+ decimal+ (fromIntegral decimalLength)+ out+ (fromIntegral capacity)+ if written < 0+ then Left . ("NUMBER: " <>) <$> icuErrorMessage written+ else Right . Text.decodeUtf8 <$> ByteString.packCStringLen (out, fromIntegral written)+ where+ locale = fromMaybe (NonEmpty.head locales) $ negotiateLocale locales+ skeleton = Number.skeleton options++ formatTime locales dateTime options =+ unsafePerformIO . fmap (first show) . try @SomeException $ do+ pattern <-+ withLocaleName locale \name ->+ withUtf8Text skeleton \wanted ->+ allocaBytes capacity \ptr -> do+ written <- fluentResolveDatePattern name wanted ptr (fromIntegral capacity)+ if written < 0+ then pure skeleton+ else Text.decodeUtf8 <$> ByteString.packCStringLen (ptr, fromIntegral written)+ formatter <- ICU.patternDateFormatter pattern locale options.timeZone+ calendar <- ICU.calendar options.timeZone locale ICU.TraditionalCalendarType+ setMillis calendar $ millisecondsSinceEpoch dateTime+ evaluate $ ICU.formatCalendar formatter calendar+ where+ capacity = 256 :: Int+ locale = fromMaybe (NonEmpty.head locales) $ negotiateLocale locales+ skeleton = Time.skeleton options++ millisecondsSinceEpoch :: UTCTime -> Double+ millisecondsSinceEpoch = (* 1000) . realToFrac . utcTimeToPOSIXSeconds++ setMillis :: Calendar -> Double -> IO ()+ setMillis calendar ms = do+ ok <- withForeignPtr calendar.calendarForeignPtr \pointer ->+ fluentSetCalendarTimeMs pointer $ realToFrac ms+ when (ok < 0) $ fail "fluentSetCalendarTimeMs failed"++-- | The name of the ICU error a negated 'fluentFormatDecimal' / 'fluentGetPluralKeyword'+-- result encodes, e.g. @U_ILLEGAL_ARGUMENT_ERROR@.+icuErrorMessage :: CInt -> IO String+icuErrorMessage written = peekCString =<< fluentErrorName (negate written)++-- | The exact decimal representation of a 'Scientific' value, as UTF-8 bytes, fit to pass+-- to ICU's decimal-string number-formatting entry points. Never round-trips through a+-- floating-point 'Double', unlike 'Data.Scientific.toRealFloat', so it can't lose precision+-- for large or high-precision values.+exactDecimal :: Scientific -> ByteString+exactDecimal = Text.encodeUtf8 . Text.pack . formatScientific Fixed Nothing++-- | Resolve a locale preference list to the best-supported locale ICU has data for.+-- Matches how @Intl@ (ECMA-402) handles its locale-list arguments.+-- 'Nothing' if none of the preferences are recognised at all.+negotiateLocale :: NonEmpty LocaleName -> Maybe LocaleName+negotiateLocale preferences = unsafePerformIO $+ withMany withLocaleName (NonEmpty.toList preferences) \accept ->+ withArrayLen accept \count array ->+ allocaBytes capacity \out -> do+ written <- fluentNegotiateSupportedLocale array (fromIntegral count) out (fromIntegral capacity)+ if written < 0+ then pure Nothing+ else Just . ICU.Locale <$> peekCStringLen (out, fromIntegral written)+ where+ capacity = 256 :: Int++-- | Pass a locale's name to a foreign function. Matches 'Data.Text.ICU.Internal.withLocaleName'.+withLocaleName :: LocaleName -> (CString -> IO a) -> IO a+withLocaleName ICU.Current = ($ nullPtr)+withLocaleName ICU.Root = withCString ""+withLocaleName (ICU.Locale name) = withCString name++withUtf8Text :: Text -> (CString -> IO a) -> IO a+withUtf8Text = ByteString.useAsCString . Text.encodeUtf8++foreign import ccall unsafe "fluent_get_display_language"+ fluentGetDisplayLanguage :: CString -> CString -> CString -> CInt -> IO CInt++foreign import ccall unsafe "fluent_format_titlecase"+ fluentFormatTitlecase :: CString -> CString -> CInt -> CString -> CInt -> IO CInt++foreign import ccall unsafe "fluent_get_plural_keyword"+ fluentGetPluralKeyword+ :: CString -> CInt -> CString -> CString -> CInt -> CString -> CInt -> IO CInt++foreign import ccall unsafe "fluent_format_decimal"+ fluentFormatDecimal :: CString -> CString -> CString -> CInt -> CString -> CInt -> IO CInt++foreign import ccall unsafe "fluent_resolve_date_pattern"+ fluentResolveDatePattern :: CString -> CString -> CString -> CInt -> IO CInt++foreign import ccall unsafe "fluent_set_calendar_time_ms"+ fluentSetCalendarTimeMs :: Ptr ICU.UCalendar -> CDouble -> IO CInt++foreign import ccall unsafe "fluent_negotiate_supported_locale"+ fluentNegotiateSupportedLocale :: Ptr CString -> CInt -> CString -> CInt -> IO CInt++foreign import ccall unsafe "fluent_error_name"+ fluentErrorName :: CInt -> IO CString
+ test/BuiltinSpec.hs view
@@ -0,0 +1,76 @@+module BuiltinSpec (spec) where++import Data.Time (UTCTime (..), fromGregorian, secondsToDiffTime)+import Prelude++spec :: Spec+spec = do+ describe "NUMBER" do+ it "formats a number by the given options" $+ written [fluent|foo = { NUMBER($arg, minimumFractionDigits: 2) }|] `shouldBe` Right "3.00"+ it "limits the significant digits it is given" $+ written [fluent|foo = { NUMBER($arg, maximumSignificantDigits: 2) }|] `shouldBe` Right "3"+ it "omits the grouping separators when turned off" $+ translate+ "foo"+ [("arg", number 1234567)]+ [fluent|foo = { NUMBER($arg, useGrouping: "false") }|]+ `shouldBe` Right "1234567"+ it "selects by the plural category of the number" $+ written+ [fluent|+ foo = { NUMBER($arg, minimumFractionDigits: 1) ->+ [one] one+ *[other] other+ }+ |]+ `shouldBe` Right "other"+ it "formats an amount of a unit" $+ written [fluent|foo = { NUMBER($arg, unit: "kilometre-per-hour") }|] `shouldBe` Right "3 km/h"+ it "spells the unit's name in full, not its symbol" $+ written+ [fluent|foo = { NUMBER($arg, unit: "litre", unitDisplay: "long") }|]+ `shouldBe` Right "3 litres"+ it "rejects a unit it does not know" $+ written [fluent|foo = { NUMBER($arg, unit: "banana") }|]+ `shouldBe` Left "NUMBER: U_NUMBER_SKELETON_SYNTAX_ERROR"+ it "rejects a style it does not know" $+ written [fluent|foo = { NUMBER($arg, style: "banana") }|]+ `shouldBe` Left "NUMBER: no such style: banana"+ describe "DATETIME" do+ it "formats a time by the given options" $+ when' [fluent|foo = { DATETIME($arg, month: "long", year: "numeric", day: "numeric") }|]+ `shouldBe` Right "10 August 2026"+ it "formats only the field it is given" $+ when' [fluent|foo = { DATETIME($arg, weekday: "long") }|] `shouldBe` Right "Monday"+ it "shifts the time by the zone it is given" $+ when'+ [fluent|foo = { DATETIME($arg, hour: "numeric", minute: "2-digit", timeZone: "Europe/Berlin") }|]+ `shouldBe` Right "14:34"+ it "defaults to a date of numbers when given no options" $+ when' [fluent|foo = { DATETIME($arg) }|] `shouldBe` Right "10/08/2026"+ it "rejects a word for a field of digits" $+ when' [fluent|foo = { DATETIME($arg, year: "long") }|]+ `shouldBe` Left "DATETIME: expected one of numeric, 2-digit for year, but got long"+ it "rejects digits for a field of words" $+ when' [fluent|foo = { DATETIME($arg, weekday: "2-digit") }|]+ `shouldBe` Left "DATETIME: expected one of narrow, short, long for weekday, but got 2-digit"+ it "formats the month in words or in digits" $ do+ when' [fluent|foo = { DATETIME($arg, month: "long") }|] `shouldBe` Right "August"+ when' [fluent|foo = { DATETIME($arg, month: "2-digit") }|] `shouldBe` Right "08"+ it "rejects a month it does not know" $+ when' [fluent|foo = { DATETIME($arg, month: "medium") }|]+ `shouldBe` Left "DATETIME: no such month: medium"+ it "rejects a positional argument that is not a time" $+ written [fluent|foo = { DATETIME($arg) }|]+ `shouldBe` Left "DATETIME: the positional argument is not a time"++written :: Resource -> Either String Text+written = translate "foo" [("arg", number 3)]++when' :: Resource -> Either String Text+when' = translate "foo" [("arg", value afternoon)]++-- | 2026-08-10, a Monday, 12:34:56 UTC.+afternoon :: UTCTime+afternoon = UTCTime (fromGregorian 2026 8 10) . secondsToDiffTime $ 12 * 3600 + 34 * 60 + 56
+ test/LocaleSpec.hs view
@@ -0,0 +1,12 @@+module LocaleSpec (spec) where++import Prelude++spec :: Spec+spec = do+ it "renders language name" $ displayLanguage de fr `shouldBe` Just "allemand"+ it "renders local language name" $ localDisplayLanguage de `shouldBe` Just "Deutsch"++de, fr :: LocaleName+de = "de"+fr = "fr"
+ test/NumberSpec.hs view
@@ -0,0 +1,102 @@+module NumberSpec (spec) where++import Prelude++spec :: Spec+spec = do+ it "groups the digits the way the locale groups them" $+ translate "foo" ("arg", NumberValue 1234567 numberOptions) resource `shouldBe` Right "1,234,567"+ it "leaves the grouping out when it is turned off" $+ translate "foo" ("arg", NumberValue 1234567 numberOptions{useGrouping = False}) resource+ `shouldBe` Right "1234567"+ it "pads the integer part to the given width" $+ translate "foo" ("arg", NumberValue 5 numberOptions{minimumIntegerDigits = 3}) resource+ `shouldBe` Right "005"+ it "limits the fraction digits to the maximum given" $+ translate "foo" ("arg", NumberValue 1.5 numberOptions{maximumFractionDigits = Just 0}) resource+ `shouldBe` Right "2"+ it "limits the significant digits it is given" $+ translate+ "foo"+ ("arg", NumberValue 1234 numberOptions{maximumSignificantDigits = Just 2})+ resource+ `shouldBe` Right "1,200"+ it "is shown as a percentage" $+ translate "foo" ("arg", NumberValue 0.25 numberOptions{style = Percent}) resource+ `shouldBe` Right "25%"+ it "is an amount of a currency" $+ translate "foo" ("arg", NumberValue 12.5 numberOptions{style = Currency "EUR"}) resource+ `shouldBe` Right "€12.50"+ it "spells the currency's name out, not its symbol" $+ translate+ "foo"+ ("arg", NumberValue 12.5 numberOptions{style = Currency "EUR", currencyDisplay = Name})+ resource+ `shouldBe` Right "12.50 euros"+ it "is an amount of a unit" $+ translate "foo" ("arg", NumberValue 5 numberOptions{style = Unit "kilometre-per-hour"}) resource+ `shouldBe` Right "5 km/h"+ it "is an amount of a unit of one thing per another" $+ translate "foo" ("arg", NumberValue 5 numberOptions{style = Unit "litre-per-kilometre"}) resource+ `shouldBe` Right "5 l/km"+ it "shows the unit's symbol when narrow, its name when long" $ do+ translate+ "foo"+ ("arg", NumberValue 5 numberOptions{style = Unit "litre", unitDisplay = Narrow})+ resource+ `shouldBe` Right "5l"+ translate+ "foo"+ ("arg", NumberValue 5 numberOptions{style = Unit "litre", unitDisplay = Long})+ resource+ `shouldBe` Right "5 litres"+ it "accepts a unit identifier written in British spelling" $ do+ translate "foo" ("arg", NumberValue 5 numberOptions{style = Unit "litre"}) resource+ `shouldBe` Right "5 l"+ translate "foo" ("arg", NumberValue 5 numberOptions{style = Unit "millilitre"}) resource+ `shouldBe` Right "5 ml"+ translate "foo" ("arg", NumberValue 5 numberOptions{style = Unit "square-kilometre"}) resource+ `shouldBe` Right "5 km²"+ it "keeps the fraction digits a unit is given" $+ translate+ "foo"+ ("arg", NumberValue 5 numberOptions{style = Unit "megabyte", minimumFractionDigits = 1})+ resource+ `shouldBe` Right "5.0 MB"+ it "spells the unit the way the locale spells it, whatever it is called" $ do+ translate+ "foo"+ ("arg", NumberValue 5 numberOptions{style = Unit "kilometre", unitDisplay = Long})+ resource+ `shouldBe` Right "5 kilometres"+ translate+ "foo"+ ("arg", NumberValue 5 numberOptions{style = Unit "litre", unitDisplay = Long})+ deCH+ resource+ `shouldBe` Right "5 Liter"+ it "rejects a unit it does not know" $+ translate "foo" ("arg", NumberValue 5 numberOptions{style = Unit "banana"}) resource+ `shouldBe` Left "NUMBER: U_NUMBER_SKELETON_SYNTAX_ERROR"+ it "uses the first known locale in the chain" $ do+ translate "foo" ("arg", NumberValue 1234.5 numberOptions) [deCH, enGB] resource+ `shouldBe` Right "1'234.5"+ translate "foo" ("arg", NumberValue 1234.5 numberOptions) [enGB, deCH] resource+ `shouldBe` Right "1,234.5"+ translate "foo" ("arg", NumberValue 1234.5 numberOptions) [unknown, deCH] resource+ `shouldBe` Right "1'234.5"+ it "falls back to an ancestor locale when the exact one is unknown" $ do+ translate "foo" ("arg", NumberValue 1234.5 numberOptions) deSince1996 resource+ `shouldBe` Right "1'234.5"+ translate "foo" ("arg", NumberValue 1234.5 numberOptions) deInAnUnknownScript resource+ `shouldBe` Right "1.234,5"++resource :: Resource+resource = [fluent|foo = { $arg }|]++enGB, deCH, deSince1996, deInAnUnknownScript, unknown :: LocaleName+enGB = "en-GB"+deCH = "de-CH"+deSince1996 = "de-CH-1996"+deInAnUnknownScript = "de-Qaai-XX"+unknown = "xx"
+ test/PluralSpec.hs view
@@ -0,0 +1,72 @@+module PluralSpec (spec) where++import Language.Fluent.ICU+import Prelude++spec :: Spec+spec = do+ describe "English" do+ it "counts one" $ translate "foo" ("arg", number 1) categories `shouldBe` Right "one"+ it "counts two" $ translate "foo" ("arg", number 2) categories `shouldBe` Right "other"+ it "counts zero" $ translate "foo" ("arg", number 0) categories `shouldBe` Right "other"+ it "counts a fraction" $ translate "foo" ("arg", number 1.5) categories `shouldBe` Right "other"+ it "counts the first" $ translate "foo" ("arg", ordinal 1) categories `shouldBe` Right "one"+ it "counts the second" $ translate "foo" ("arg", ordinal 2) categories `shouldBe` Right "two"+ it "counts the third" $ translate "foo" ("arg", ordinal 3) categories `shouldBe` Right "few"+ it "counts the fourth" $ translate "foo" ("arg", ordinal 4) categories `shouldBe` Right "other"+ it "counts the twenty second" $+ translate "foo" ("arg", ordinal 22) categories `shouldBe` Right "two"++ describe "other languages" do+ it "counts twenty one in Russian" $+ translate "foo" ("arg", number 21) ru categories `shouldBe` Right "one"+ it "counts twenty two in Russian" $+ translate "foo" ("arg", number 22) ru categories `shouldBe` Right "few"+ it "counts five in Russian" $+ translate "foo" ("arg", number 5) ru categories `shouldBe` Right "many"+ it "counts two in Welsh" $+ translate "foo" ("arg", number 2) cy categories `shouldBe` Right "two"+ it "counts six in Welsh" $+ translate "foo" ("arg", number 6) cy categories `shouldBe` Right "many"+ it "counts zero in Arabic" $+ translate "foo" ("arg", number 0) ar categories `shouldBe` Right "zero"+ it "counts one hundred and three in Arabic" $+ translate "foo" ("arg", number 103) ar categories `shouldBe` Right "few"+ it "counts one in Japanese, which does not count" $+ translate "foo" ("arg", number 1) ja categories `shouldBe` Right "other"++ describe "a message written for one language" do+ it "reads as a plural in English" $+ translate "apples" ("count", number 2) apples `shouldBe` Right "2 apples"+ it "reads as a singular in English" $+ translate "apples" ("count", number 1) apples `shouldBe` Right "1 apple"+ it "falls to the default in a language with more categories" $+ translate "apples" ("count", number 5) ru apples `shouldBe` Right "5 apples"++ru, cy, ar, ja :: LocaleName+ru = "ru"+cy = "cy"+ar = "ar"+ja = "ja"++categories :: Resource+categories =+ [fluent|+ foo = { $arg ->+ [zero] zero+ [one] one+ [two] two+ [few] few+ [many] many+ *[other] other+ }+ |]++apples :: Resource+apples =+ [fluent|+ apples = { $count ->+ [one] { $count } apple+ *[other] { $count } apples+ }+ |]
+ test/Prelude.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE PackageImports #-}++module Prelude+ ( module Prelude+ , module Data.Scientific+ , module Data.Text+ , module Data.Time+ , module Language.Fluent+ , module Language.Fluent.ICU+ , module Test.Hspec+ )+where++import Data.Foldable qualified as Foldable+import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Scientific (Scientific)+import Data.Text (Text)+import Data.Time (UTCTime)+import Language.Fluent+import Language.Fluent.Bundle qualified as Bundle+import Language.Fluent.ICU+import Language.Fluent.Locale qualified as Locale+import Test.Hspec+import "base" Prelude++instance+ (Foldable f, r ~ Either String Text)+ => Translate (f LocaleName -> Resource -> r)+ where+ translate arguments (Foldable.toList -> NonEmpty.fromList -> locales) =+ translate arguments+ . Bundle.override (Bundle.UseIsolating False)+ . bundle locales+ . pure++instance (r ~ Either String Text) => Translate (LocaleName -> Resource -> r) where+ translate arguments = translate arguments . pure @NonEmpty++instance (r ~ Either String Text) => Translate (Resource -> r) where+ translate arguments = translate arguments $ Locale.fromCode @LocaleName "en-GB"++number :: Scientific -> SomeValue+number = numberWith Cardinal 0++ordinal :: Scientific -> SomeValue+ordinal = numberWith Ordinal 0++numberWith :: Form -> Int -> Scientific -> SomeValue+numberWith form minimumFractionDigits amount =+ NumberValue amount numberOptions{form, minimumFractionDigits}
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/TimeSpec.hs view
@@ -0,0 +1,64 @@+module TimeSpec (spec) where++import Data.Time+import Prelude++spec :: Spec+spec = do+ it "is a date of numbers when given nothing" $+ translate "foo" ("when", TimeValue afternoon timeOptions) resource `shouldBe` Right "10/08/2026"+ it "formats the date to match the locale's convention" $+ translate "foo" ("when", TimeValue afternoon timeOptions) deCH resource `shouldBe` Right "10.8.2026"+ it "spells the month out at the width it is given" $+ translate+ "foo"+ ("when", TimeValue afternoon dated{month = Just (Right Long)})+ resource+ `shouldBe` Right "10 August 2026"+ it "formats only the field it is given" $+ translate "foo" ("when", TimeValue afternoon timeOptions{month = Just (Right Long)}) resource+ `shouldBe` Right "August"+ it "spells the weekday out" $+ translate "foo" ("when", TimeValue afternoon timeOptions{weekday = Just Long}) resource+ `shouldBe` Right "Monday"+ it "shows the time of day it is given" $+ translate "foo" ("when", TimeValue afternoon clock) resource `shouldBe` Right "12:34"+ it "formats the month in digits or in words, beside a year of digits" $ do+ translate+ "foo"+ ("when", TimeValue afternoon timeOptions{year = Just Numeric, month = Just (Right Narrow)})+ resource+ `shouldBe` Right "A 2026"+ translate+ "foo"+ ("when", TimeValue afternoon timeOptions{year = Just Numeric, month = Just (Left TwoDigit)})+ resource+ `shouldBe` Right "08/2026"+ it "reads the time in the zone it is given" $+ translate "foo" ("when", TimeValue afternoon berlin) resource `shouldBe` Right "14:34"+ it "keeps the hour the zone keeps at that time of year" $+ translate "foo" ("when", TimeValue midwinter berlin) resource `shouldBe` Right "13:34"++resource :: Resource+resource = [fluent|foo = { $when }|]++deCH :: LocaleName+deCH = "de-CH"++dated :: TimeOptions+dated = timeOptions{day = Just Numeric, year = Just Numeric}++clock :: TimeOptions+clock = timeOptions{hour = Just Numeric, minute = Just TwoDigit, hour12 = Just False}++berlin :: TimeOptions+berlin = clock{timeZone = "Europe/Berlin"}++time :: DiffTime+time = secondsToDiffTime $ foldl' ((+) . (60 *)) 0 [12, 34, 56]++afternoon :: UTCTime+afternoon = UTCTime (fromGregorian 2026 8 10) time++midwinter :: UTCTime+midwinter = UTCTime (fromGregorian 2026 1 10) time