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/cbits.c b/cbits.c new file mode 100644 --- /dev/null +++ b/cbits.c @@ -0,0 +1,274 @@ +#include + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +/* + * 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; +} diff --git a/fluent-icu.cabal b/fluent-icu.cabal new file mode 100644 --- /dev/null +++ b/fluent-icu.cabal @@ -0,0 +1,85 @@ +cabal-version: 3.0 +name: fluent-icu +version: 1.0.0 +synopsis: ICU backend for fluent +description: ICU backend for . +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, diff --git a/src/Language/Fluent/ICU.hs b/src/Language/Fluent/ICU.hs new file mode 100644 --- /dev/null +++ b/src/Language/Fluent/ICU.hs @@ -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 +-- +-- localisation backed by +-- using the +-- 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 diff --git a/test/BuiltinSpec.hs b/test/BuiltinSpec.hs new file mode 100644 --- /dev/null +++ b/test/BuiltinSpec.hs @@ -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 diff --git a/test/LocaleSpec.hs b/test/LocaleSpec.hs new file mode 100644 --- /dev/null +++ b/test/LocaleSpec.hs @@ -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" diff --git a/test/NumberSpec.hs b/test/NumberSpec.hs new file mode 100644 --- /dev/null +++ b/test/NumberSpec.hs @@ -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" diff --git a/test/PluralSpec.hs b/test/PluralSpec.hs new file mode 100644 --- /dev/null +++ b/test/PluralSpec.hs @@ -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 + } + |] diff --git a/test/Prelude.hs b/test/Prelude.hs new file mode 100644 --- /dev/null +++ b/test/Prelude.hs @@ -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} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/TimeSpec.hs b/test/TimeSpec.hs new file mode 100644 --- /dev/null +++ b/test/TimeSpec.hs @@ -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