miso-fluent (empty) → 1.0.0
raw patch · 8 files changed
+1055/−0 lines, 8 filesdep +basedep +fluentdep +fluent-syntaxsetup-changed
Dependencies added: base, fluent, fluent-syntax, hspec, miso, miso-fluent, scientific, text, time
Files
- CHANGELOG.md +12/−0
- LICENCE +287/−0
- Setup.hs +2/−0
- miso-fluent.cabal +90/−0
- src/Miso/Fluent.hs +160/−0
- src/Miso/Fluent/Intl.hs +202/−0
- src/Miso/Fluent/Parser.hs +10/−0
- test/Main.hs +292/−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
+ miso-fluent.cabal view
@@ -0,0 +1,90 @@+cabal-version: 3.0+name: miso-fluent+version: 1.0.0+synopsis: Translate miso apps with Project Fluent+description:+ In-browser <https://projectfluent.org Project Fluent> localisation backed by+ <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl Intl>.++license: EUPL-1.2+license-file: LICENCE+author: IDA+maintainer: IDA+homepage: https://digital-autonomy.institute+bug-reports: https://issues.digital-autonomy.institute+category: Web, 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++ if (impl(ghcjs) || arch(javascript))+ cpp-options: -DGHCJS_BROWSER+ elif arch(wasm32)+ cpp-options: -DWASM+ else+ cpp-options: -DVANILLA++ default-extensions:+ BlockArguments+ DerivingStrategies+ FlexibleInstances+ GeneralizedNewtypeDeriving+ ImportQualifiedPost+ LambdaCase+ NamedFieldPuns+ NoImplicitPrelude+ OverloadedRecordDot+ OverloadedStrings+ QuasiQuotes+ TypeApplications+ TypeOperators+ ViewPatterns++ build-depends:+ base >=4 && <5,+ miso >=1.14 && <1.15,+ time >=1.12 && <1.17,++library+ import: common+ hs-source-dirs: src+ build-depends:+ fluent >=1.0 && <1.1,+ fluent-syntax >=1.0 && <1.1,+ scientific >=0.3 && <0.4,+ text >=2.1 && <2.2,++ exposed-modules:+ Miso.Fluent+ Miso.Fluent.Intl+ Miso.Fluent.Parser++executable miso-fluent-test+ import: common+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ hspec >=2.11 && <2.12,+ miso-fluent,++ if (impl(ghcjs) || arch(javascript))+ ld-options: -sEXPORTED_RUNTIME_METHODS=HEAP8+ elif arch(wasm32)+ ghc-options:+ -no-hs-main+ -optl-mexec-model=reactor+ "-optl-Wl,--export=hs_start"
+ src/Miso/Fluent.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Trustworthy #-}+{-# OPTIONS_GHC -Wno-name-shadowing #-}++-- |+-- Module : Miso.Fluent+-- Copyright : (c) 2026 Institute for Digital Autonomy+-- License : EUPL-1.2+-- Maintainer : IDA+--+-- In-browser <https://projectfluent.org Project Fluent> localisation backed by+-- <https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/Intl Intl>.+--+-- 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|+-- > greeting = Hello!+-- > welcome = Welcome, { $name }+-- > |]+--+-- Or parse Fluent source at runtime from an asynchronous 'getText' request:+--+-- > getText "/static/en-GB.ftl" []+-- > (\res -> SetResource $ Fluent.parse Fluent.resource (body res))+-- > (\err -> SetResource $ Left "Failed to fetch .ftl file")+--+-- == 2. Building bundles+--+-- Combine 'Resource's and 'Locale's into a 'Bundle' using 'bundle':+--+-- > let english = bundle @Locale (pure "en-GB") [resource]+--+-- == 3. Translating+--+-- 'translate' is overloaded on its return type, allowing a message to be translated+-- into a plain 'MisoString' or directly into a 'View'.+--+-- === To 'MisoString'+--+-- Translate directly against a 'Bundle':+--+-- > translate "welcome" ("name", "Ann" :: MisoString) (UseIsolating False) english :: Either String MisoString+-- > -- Right "Welcome, Ann"+--+-- If you request a plain 'MisoString' instead of 'Either', errors are logged to the+-- browser console and the error message is returned as fallback text:+--+-- > translate "welcome" ("name", "Ann" :: MisoString) english :: MisoString+-- > -- "Welcome, Ann"+--+-- === To 'View'+--+-- When returning a 'View', 'translate' automatically retrieves the 'Bundle' from the ambient Miso context,+-- which must implement 'Fluent':+--+-- > data Context = Context { bundle :: Bundle Locale }+-- > deriving anyclass (Fluent)+--+-- Render directly to a text node:+--+-- > greeting :: View Context props model action+-- > greeting = translate "greeting"+--+-- Pass a continuation to customise element wrapping:+--+-- > welcome :: View Context props model action+-- > welcome = translate "welcome" ("name", "Ann" :: MisoString) \msg ->+-- > p_ [] [text msg]+--+-- Or accept an 'Either' in the continuation to handle translation failures explicitly:+--+-- > welcome :: View Context props model action+-- > welcome = translate "welcome" ("name", "Ann" :: MisoString) \case+-- > Right msg -> p_ [] [text msg]+-- > Left err -> p_ [class_ "error"] [text $ toMisoString err]+module Miso.Fluent+ ( Fluent (..)+ , Locale (..)++ -- * Re-exports+ , module Language.Fluent+ )+where++import Data.String (IsString (..))+import Data.Text (Text)+import GHC.Records (HasField)+import Language.Fluent hiding (Locale)+import Miso.Fluent.Intl (Locale (..))+import Miso.Prelude hiding (context, props)+import Miso.String (FromMisoString (..))+import Miso.Trace (traceErrorId)++-- | Types that can supply a translation 'Bundle'.+--+-- This is usually a context or a model type.+class Fluent f where+ getBundle :: f -> Bundle Locale+ default getBundle :: (HasField "bundle" f (Bundle Locale)) => f -> Bundle Locale+ getBundle = (.bundle)++instance Fluent (Bundle Locale) where+ getBundle = id++instance FromMisoString SomeValue where+ fromMisoStringEither = fmap StringValue . fromMisoStringEither++instance FromMisoString Reference where+ fromMisoStringEither = Right . fromString . fromMisoString++#ifndef VANILLA+instance Value MisoString where value = value . fromMisoString @Text+#endif++instance {-# OVERLAPPABLE #-} (Fluent context) => Translate (context -> Either String MisoString) where+ translate ref context = toMisoString @Text <$> translate ref (getBundle context)++instance+ (Fluent context, context ~ context', props ~ props', model' ~ model, action ~ action')+ => Translate+ ((Either String MisoString -> View context' props' model' action') -> View context props model action)+ where+ translate ref f = withContext \(getBundle -> bundle) -> f $ translate ref bundle++instance+ (Fluent context, context ~ context', props ~ props', model' ~ model, action ~ action')+ => Translate+ ( (Either String MisoString -> [View context' props' model' action'])+ -> View context props model action+ )+ where+ translate ref f = translate ref $ fragment . f++instance+ (Fluent context, context ~ context', props ~ props', model' ~ model, action ~ action')+ => Translate ((MisoString -> [View context' props' model' action']) -> View context props model action)+ where+ translate ref f = translate ref $ f . either (traceErrorId . toMisoString @String) id++instance (Fluent context) => Translate (context -> MisoString) where+ translate ref = either (traceErrorId . toMisoString @String) id . translate ref++instance+ (Fluent context, context ~ context', props ~ props', model' ~ model, action ~ action')+ => Translate ((MisoString -> View context' props' model' action') -> View context props model action)+ where+ translate ref f = translate ref $ pure @[] . f++instance (Fluent context) => Translate (View context props model action) where+ translate ref = translate ref text
+ src/Miso/Fluent/Intl.hs view
@@ -0,0 +1,202 @@+module Miso.Fluent.Intl where++import Data.Char (isAlpha, toLower)+import Data.Function ((&))+import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NonEmpty+import Data.Maybe (fromMaybe, isJust)+import Data.Scientific (toRealFloat)+import Data.String (IsString)+import Data.Text qualified as Text+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import Language.Fluent+ ( Digits (..)+ , NumberOptions (..)+ , Style (..)+ , TimeOptions (..)+ , Width (..)+ )+import Language.Fluent.Locale qualified as Fluent+import Language.Fluent.Number qualified as Number+import Language.Fluent.Plural qualified as Plural+import Language.Fluent.Time qualified as Time+import Miso.FFI.QQ (js)+import Miso.JSON (Pair, Value, (.=))+import Miso.JSON qualified as JSON+import Miso.Prelude+import Miso.String (FromMisoString, ToMisoString)+import System.IO.Unsafe (unsafePerformIO)+import Text.Read (readMaybe)++-- | A BCP 47 language tag (e.g. @"en-GB"@ or @"de-CH"@).+newtype Locale = Locale MisoString+ deriving newtype+ ( Eq+ , Ord+ , Show+ , IsString+ , ToMisoString+ , FromMisoString+ , ToJSVal+ , FromJSVal+ )++instance Fluent.Locale Locale where+ fromCode code =+ unsafePerformIO+ [js|+ try {+ return Intl.DateTimeFormat.supportedLocalesOf(+ [${code}],+ { localeMatcher: "lookup" },+ )[0] ?? "";+ } catch {+ return "";+ }+ |]+ & \case+ "" -> Nothing+ code' -> Just code'++ toCode (Locale it) = fromMisoString it++ displayLanguage (Locale a) (Locale b) =+ case unsafePerformIO+ [js|+ try {+ const { language } = new Intl.Locale(${a});+ return new Intl.DisplayNames([${b}], { type: "language" }).of(language) ?? "";+ } catch {+ return "";+ }+ |] of+ "" -> Nothing+ name -> Just name++ capitalise (Locale l) t =+ unsafePerformIO+ [js|+ try {+ return ${t}.replace(/^./u, (first) => first.toLocaleUpperCase(${l}));+ } catch {+ return ${t};+ }+ |]++ pluralCategory locale value options =+ unsafePerformIO+ . pluralRules locale (JSON.object $ "type" .= kind : digits options)+ $ toRealFloat value+ where+ kind = toMisoString . fmap toLower . show $ options.form++ formatNumber locales value options =+ maybe (Left "could not format number") (Right . fromMisoString)+ . unsafePerformIO+ . numberFormat locales (JSON.object $ style <> digits options)+ $ toRealFloat value+ where+ style = case options.style of+ Decimal -> []+ Percent -> ["style" .= ("percent" :: MisoString)]+ Currency code ->+ [ "style" .= ("currency" :: MisoString)+ , "currency" .= (toMisoString . Text.filter isAlpha) code+ , "currencyDisplay" .= toMisoString (toLower <$> show options.currencyDisplay)+ ]+ Unit unit ->+ [ "style" .= ("unit" :: MisoString)+ , "unit" .= toMisoString (Number.unitIdentifier unit)+ , "unitDisplay" .= toMisoString (toLower <$> show options.unitDisplay)+ ]++ formatTime locales dateTime options =+ maybe (Left "could not format time") (Right . fromMisoString)+ . unsafePerformIO+ . dateTimeFormat locales options'+ $ millisecondsSinceEpoch dateTime+ where+ options' :: Value+ options' =+ JSON.object+ $ ["timeZone" .= toMisoString options.timeZone]+ <> ["hour12" .= it | Just it <- [options.hour12]]+ <> fmap field (Time.fields options)++ field :: (Char, Either Digits Width) -> Pair+ field (symbol, written) = name symbol .= toMisoString (toLower <$> either show show written)++ name :: Char -> MisoString+ name 'G' = "era"+ name 'y' = "year"+ name 'M' = "month"+ name 'd' = "day"+ name 'E' = "weekday"+ name 'm' = "minute"+ name 's' = "second"+ name 'z' = "timeZoneName"+ name _ = "hour"++ millisecondsSinceEpoch :: UTCTime -> Double+ millisecondsSinceEpoch = (1000 *) . realToFrac . utcTimeToPOSIXSeconds++digits :: NumberOptions -> [Pair]+digits options =+ ["minimumIntegerDigits" .= options.minimumIntegerDigits | options.minimumIntegerDigits > 1]+ <> ["useGrouping" .= False | not options.useGrouping]+ <> precision+ where+ precision+ | Just (least, most) <- Number.significantDigits options =+ [ "minimumSignificantDigits" .= least+ , "maximumSignificantDigits" .= most+ ]+ | options.minimumFractionDigits > 0 || isJust options.maximumFractionDigits =+ [ "minimumFractionDigits" .= atLeast+ , "maximumFractionDigits" .= atMost+ ]+ | otherwise = []+ (atLeast, atMost) = Number.fractionDigits options++instance ToJSVal (NonEmpty Locale) where+ toJSVal = JSON.toJSVal_Value . JSON.toJSON . fmap (toMisoString @Locale) . NonEmpty.toList++numberFormat :: NonEmpty Locale -> Value -> Double -> IO (Maybe MisoString)+numberFormat locales value amount = do+ locale <- toJSVal locales+ options <- JSON.toJSVal_Value value+ [js|+ try {+ return new Intl.NumberFormat(${locale}, ${options}).format(${amount});+ } catch {+ return null;+ }+ |]++pluralRules :: Locale -> Value -> Double -> IO Plural.Category+pluralRules locale value amount = do+ options <- JSON.toJSVal_Value value+ [js|+ return new Intl.PluralRules(${locale}, ${options}).select(${amount});+ |]++instance FromJSVal Plural.Category where+ fromJSVal = fmap (readMaybe =<<) . fromJSVal+ fromJSValUnchecked = fmap (fromMaybe Plural.Other) . fromJSVal++dateTimeFormat :: NonEmpty Locale -> Value -> Double -> IO (Maybe MisoString)+dateTimeFormat locales value epoch = do+ locale <- toJSVal locales+ options <- JSON.toJSVal_Value value+ [js|+ try {+ return new Intl.DateTimeFormat(${locale}, ${options}).format(new Date(${epoch}));+ } catch {+ return null;+ }+ |]++-- | The IANA time zone the browser is set to, e.g. @"Europe/Zurich"@.+localTimeZone :: IO MisoString+localTimeZone = [js| return Intl.DateTimeFormat().resolvedOptions().timeZone; |]
+ src/Miso/Fluent/Parser.hs view
@@ -0,0 +1,10 @@+module Miso.Fluent.Parser (parse, Fluent.resource) where++import Data.Text (Text)+import Language.Fluent.Parser (Parser)+import Language.Fluent.Parser qualified as Fluent+import Language.Fluent.Parser qualified as Parser+import Miso.Prelude++parse :: Parser a -> MisoString -> Either String a+parse = (. fromMisoString @Text) . Parser.parse
+ test/Main.hs view
@@ -0,0 +1,292 @@+{-# LANGUAGE CPP #-}++module Main (main) where++import Data.Either (isLeft)+import Data.Time (UTCTime (..), fromGregorian, secondsToDiffTime)+import Miso.Fluent+import Miso.Prelude+import Test.Hspec+ ( Expectation+ , HasCallStack+ , Spec+ , describe+ , hspec+ , it+ , shouldBe+ , shouldSatisfy+ )++#ifdef WASM+foreign export javascript "hs_start" main :: IO ()+#endif++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "Locale" do+ describe "from a tag" do+ it "known" do+ fromCode "en-GB" `shouldBe` Just (Locale "en-GB")+ fromCode "ja" `shouldBe` Just (Locale "ja")+ it "mixed case" $ fromCode "EN-gb" `shouldBe` Just (Locale "en-GB")+ it "unknown" $ fromCode "banana" `shouldBe` (Nothing :: Maybe Locale)+ it "no tag at all" $ fromCode "en_GB" `shouldBe` (Nothing :: Maybe Locale)+ it "display language" $ displayLanguage ja deCH `shouldBe` Just "Japanisch"+ it "local display language" $ localDisplayLanguage ja `shouldBe` Just "日本語"++ describe "Number" do+ describe "grouping" do+ it "grouped digits"+ $ translate "value" ("arg", NumberValue 1234567 numberOptions) enGB resource+ `shouldBe` Right "1,234,567"+ it "no grouping"+ $ translate "value" ("arg", NumberValue 1234567 numberOptions{useGrouping = False}) enGB resource+ `shouldBe` Right "1234567"+ describe "digits" do+ it "at least three integer digits"+ $ translate "value" ("arg", NumberValue 5 numberOptions{minimumIntegerDigits = 3}) enGB resource+ `shouldBe` Right "005"+ it "no fraction digits"+ $ translate+ "value"+ ("arg", NumberValue 1.5 numberOptions{maximumFractionDigits = Just 0})+ enGB+ resource+ `shouldBe` Right "2"+ it "two significant digits"+ $ translate+ "value"+ ("arg", NumberValue 1234 numberOptions{maximumSignificantDigits = Just 2})+ enGB+ resource+ `shouldBe` Right "1,200"+ it "at least four significant digits"+ $ translate+ "value"+ ("arg", NumberValue 1.5 numberOptions{minimumSignificantDigits = Just 4})+ enGB+ resource+ `shouldBe` Right "1.500"+ describe "style" do+ it "a percentage"+ $ translate "value" ("arg", NumberValue 0.25 numberOptions{style = Percent}) enGB resource+ `shouldBe` Right "25%"+ it "an amount of money"+ $ translate "value" ("arg", NumberValue 12.5 numberOptions{style = Currency "EUR"}) enGB resource+ `shouldBe` Right "€12.50"+ it "an amount of a unit"+ $ translate+ "value"+ ("arg", NumberValue 5 numberOptions{style = Unit "kilometre-per-hour"})+ enGB+ resource+ `shouldBe` Right "5 km/h"+ it "an unknown unit"+ $ shouldFail+ $ translate "value" ("arg", NumberValue 5 numberOptions{style = Unit "banana"}) enGB resource+ describe "currency" do+ it "a code beside the amount"+ $ translate+ "value"+ ("arg", NumberValue 12.5 numberOptions{style = Currency "EUR", currencyDisplay = Code})+ enGB+ resource+ `shouldBe` Right "EUR\160\&12.50"+ it "a name beside the amount"+ $ translate+ "value"+ ("arg", NumberValue 12.5 numberOptions{style = Currency "EUR", currencyDisplay = Name})+ enGB+ resource+ `shouldBe` Right "12.50 euros"+ describe "unit" do+ it "narrow and long names" do+ translate+ "value"+ ("arg", NumberValue 5 numberOptions{style = Unit "litre", unitDisplay = Narrow})+ enGB+ resource+ `shouldBe` Right "5l"+ translate+ "value"+ ("arg", NumberValue 5 numberOptions{style = Unit "litre", unitDisplay = Long})+ enGB+ resource+ `shouldBe` Right "5 litres"+ it "the locale's own name"+ $ translate+ "value"+ ("arg", NumberValue 5 numberOptions{style = Unit "litre", unitDisplay = Long})+ deCH+ resource+ `shouldBe` Right "5 Liter"+ it "the locale's own format"+ $ translate+ "value"+ ("arg", NumberValue 1234.5 numberOptions{minimumFractionDigits = 1})+ deCH+ resource+ `shouldBe` Right "1'234.5"++ describe "Plural" do+ it "en-GB" do+ translate "counted" ("arg", NumberValue 1 numberOptions) enGB resource+ `shouldBe` Right "one"+ translate "counted" ("arg", NumberValue 2 numberOptions) enGB resource+ `shouldBe` Right "other"+ it "ja" do+ translate "counted" ("arg", NumberValue 1 numberOptions) ja resource+ `shouldBe` Right "other"+ translate "counted" ("arg", NumberValue 2 numberOptions) ja resource+ `shouldBe` Right "other"+ translate "counted" ("arg", NumberValue 5 numberOptions) ja resource+ `shouldBe` Right "other"+ it "ordinals" do+ translate "counted" ("arg", NumberValue 1 ordinal) enGB resource+ `shouldBe` Right "one"+ translate "counted" ("arg", NumberValue 2 ordinal) enGB resource+ `shouldBe` Right "two"+ translate "counted" ("arg", NumberValue 3 ordinal) enGB resource+ `shouldBe` Right "few"+ translate "counted" ("arg", NumberValue 4 ordinal) enGB resource+ `shouldBe` Right "other"++ describe "Time" do+ it "a date of numbers"+ $ translate "value" ("arg", TimeValue afternoon timeOptions) enGB resource+ `shouldBe` Right "10/08/2026"+ it "the locale's own order"+ $ translate "value" ("arg", TimeValue afternoon timeOptions) deCH resource+ `shouldBe` Right "10.8.2026"+ describe "month" do+ it "a long name"+ $ translate+ "value"+ ("arg", TimeValue afternoon dated{month = Just (Right Long)})+ enGB+ resource+ `shouldBe` Right "10 August 2026"+ it "a long name on its own"+ $ translate+ "value"+ ("arg", TimeValue afternoon timeOptions{month = Just (Right Long)})+ enGB+ resource+ `shouldBe` Right "August"+ it "short and narrow names" do+ translate "value" ("arg", TimeValue afternoon dated{month = Just (Right Short)}) enGB resource+ `shouldBe` Right "10 Aug 2026"+ translate+ "value"+ ("arg", TimeValue afternoon timeOptions{month = Just (Right Narrow)})+ enGB+ resource+ `shouldBe` Right "A"+ it "weekday names" do+ translate "value" ("arg", TimeValue afternoon timeOptions{weekday = Just Long}) enGB resource+ `shouldBe` Right "Monday"+ translate "value" ("arg", TimeValue afternoon timeOptions{weekday = Just Short}) enGB resource+ `shouldBe` Right "Mon"+ translate "value" ("arg", TimeValue afternoon timeOptions{weekday = Just Narrow}) enGB resource+ `shouldBe` Right "M"+ it "a two-digit year and day" do+ translate "value" ("arg", TimeValue afternoon timeOptions{year = Just TwoDigit}) enGB resource+ `shouldBe` Right "26"+ translate "value" ("arg", TimeValue afternoon timeOptions{day = Just TwoDigit}) enGB resource+ `shouldBe` Right "10"+ it "an era"+ $ translate+ "value"+ ("arg", TimeValue afternoon timeOptions{era = Just Short, year = Just Numeric})+ enGB+ resource+ `shouldBe` Right "2026 AD"+ describe "clock" do+ it "an hour and a minute"+ $ translate "value" ("arg", TimeValue afternoon clock{hour12 = Just False}) enGB resource+ `shouldBe` Right "12:34"+ it "seconds"+ $ translate+ "value"+ ("arg", TimeValue afternoon clock{second = Just TwoDigit, hour12 = Just False})+ enGB+ resource+ `shouldBe` Right "12:34:56"+ it "the locale's own clock"+ $ translate "value" ("arg", TimeValue afternoon clock) enGB resource+ `shouldBe` Right "12:34"+ it "a twelve-hour clock"+ $ translate "value" ("arg", TimeValue afternoon clock{hour12 = Just True}) enGB resource+ `shouldBe` Right "12:34 pm"+ describe "time zone" do+ it "short and long names" do+ translate+ "value"+ ("arg", TimeValue afternoon clock{timeZoneName = Just Short, hour12 = Just False})+ enGB+ resource+ `shouldBe` Right "12:34 UTC"+ translate+ "value"+ ("arg", TimeValue afternoon clock{timeZoneName = Just Long, hour12 = Just False})+ enGB+ resource+ `shouldBe` Right "12:34 Coordinated Universal Time"+ it "another zone"+ $ translate "value" ("arg", TimeValue afternoon berlin) enGB resource+ `shouldBe` Right "14:34"+ it "another zone in winter"+ $ translate "value" ("arg", TimeValue midwinter berlin) enGB resource+ `shouldBe` Right "13:34"++ describe "Translations" do+ it "MisoString"+ $ translate "hello" (bundle (pure enGB) $ pure resource)+ `shouldBe` ("Hello" :: MisoString)+ it "View" $ (translate "hello" :: View (Bundle Locale) () () ()) `seq` pure @IO ()++shouldFail :: (HasCallStack) => Either String MisoString -> Expectation+shouldFail actual = actual `shouldSatisfy` isLeft++resource :: Resource+resource =+ [fluent|+ hello = Hello+ value = { $arg }+ counted = { $arg ->+ [one] one+ [two] two+ [few] few+ [many] many+ *[other] other+ }+ |]++instance (r ~ Either String MisoString) => Translate (Locale -> Resource -> r) where+ translate reference locale = translate reference . bundle (pure locale) . pure++enGB, deCH, ja :: Locale+enGB = Locale "en-GB"+deCH = Locale "de-CH"+ja = Locale "ja"++ordinal :: NumberOptions+ordinal = numberOptions{form = Ordinal}++dated :: TimeOptions+dated = timeOptions{day = Just Numeric, year = Just Numeric}++clock :: TimeOptions+clock = timeOptions{hour = Just Numeric, minute = Just TwoDigit}++berlin :: TimeOptions+berlin = clock{timeZone = "Europe/Berlin", hour12 = Just False}++afternoon :: UTCTime+afternoon = UTCTime (fromGregorian 2026 8 10) . secondsToDiffTime $ 12 * 3600 + 34 * 60 + 56++midwinter :: UTCTime+midwinter = UTCTime (fromGregorian 2026 1 10) . secondsToDiffTime $ 12 * 3600 + 34 * 60 + 56