react-flux-1.2.3: A binding to React based on the Flux application architecture for GHCJS

Safe HaskellNone
LanguageHaskell2010

React.Flux.Addons.Intl

Contents

Description

Bindings to the ReactIntl library version 2, which allows easy formatting of numbers, dates, times, relative times, pluralization, and translated messages. This library can be used for formatting and pluralization even if you intend to present your application in a single language and locale.

To use these bindings, you need to provide the ReactIntl variable. In the browser you can just load the react-intl.min.js script onto the page so that window.ReactIntl exists. If you are running in node, execute ReactIntl = require("ReactIntl"); so that global.ReactIntl exists. When compiling with closure, protect the ReactIntl variable as follows:

(function(global, React, ReactDOM, ReactIntl) {
contents of all.js
})(window, window['React'], window['ReactDOM'], window['ReactIntl']);

Using with a single locale and no translations. If you intend to present your application in a single language, you can still use this module for formatting. Add a call to intlProvider_ to the top of your app with a hard-coded locale and Nothing for the messages. You can then use anything in the Formatting section like int_, relativeTo_, and message, where message will just always use the default message provided in the source code (helpful for templating). If you want to specify the locale so dates and numbers are formatted in the user's locale, it is strongly recommended to set the locale from the server based on the Accept-Language header and/or a user setting so that the page as a whole is consistint. I have the server set a variable on window for the locale to use, and then pass that locale into intlProvider_.

Translations. The react-intl philosophy is that messages should be defined in the source code instead of kept in a separate file. To support translations, a tool (in this case Template Haskell) is used to extract the messages from the source code into a file given to the translators. The result of the translation is then used to replace the default message given in the source code.

  1. Use the functions in the Formatting section like int_, relativeTo_, and message inside your rendering functions.
  2. At the bottom of each file which contains messages, add a call to writeIntlMessages. This is a template haskell function which during compilation will produce a file containing all the messages found within the haskell module.
  3. Give these message files to your translators. The translation results will then need to be converted into javascript files in the format expected by ReactIntl, which is a javascript object with keys the MessageIds and value the translated message. For example, each translation could result in a javascript file such as the following:

    window.myMessages = window.myMessages || {};
    window.myMessages["fr-FR"] = {
       "num_photos": "{name} {numPhotos, plural, =0 {n'a pas pris de photographie.} =1 {a pris une photographie.} other {a pris # photographies.}",
       ...
    };
    
  4. Based on the Accept-Language header and/or a user setting, the server includes the appropriate translation javascript file and sets a variable on window containing the locale to use. Note that no translation javascript file is needed if the default messages from the source code should be used.

    <script type="text/javascript">window.myIntialConfig = { "locale": "fr-FR" };</script>
    <script src="path/to/translations.fr-FR.js"></script>
    
  5. Add a call to intlProvider_ at the top of your application, passing the locale and the messages.

    foreign import javascript unsafe
      "$r = window['myInitialConfig']['locale']"
      js_initialLocale :: JSString
    
    foreign import javascript unsafe
      "window['myMessages'] ? window['myMessages'][$1] : null"
      js_myMessages :: JSString -> JSVal
    
    myApp :: ReactView ()
    myApp = defineView "my application" $ () -> do
        intlProvider_ (JSString.unpack js_initialLocale) (Just $ js_myMessages js_initialLocale) $
          ...
    

    If you want to allow changing the locale without a page refresh, just load the initial locale into a store and use a controller-view to pass the locale and lookup the messages for intlProvider_.

Synopsis

Documentation

intlProvider_ Source #

Arguments

:: JSString

the locale to use

-> Maybe JSVal

A reference to translated messages, which must be an object with keys MessageId and value the translated message. Set this as Nothing if you are not using translated messages, since either Nothing or a null JSVal will cause the messages from the source code to be used.

-> Maybe Object

An object to use for the formats parameter which allows custom formats. I suggest you use custom formats only for messages. Custom formats for numbers and dates not in a message is better done by writing a small Haskell utility function wrapping for example formattedNumber_.

-> ReactElementM eventHandler a

The children of this element. All descendents will use the given locale and messages.

-> ReactElementM eventHandler a 

Use the IntlProvider to set the locale, formats, and messages property.

Formatting

data IntlProperty Source #

A property and value that is passed to the intl elements below in situations where React elements can not be used.

Some of the intl elements below such as message (among others) allow other React elements to be passed as properties. In this case, PropertyOrHandler is used as the type for the parameters and elements can be passed using elementProperty. But for some intl elements below such as messageProp, a limitation on the internals of this react-flux package disallow element properties to be created and so only basic javascript values can be passed. In these situations, the type IntlProperty is used to restrict the properties to basic javascript values.

iprop :: ToJSVal v => JSString -> v -> IntlProperty Source #

Create an IntlProperty from a property name and anything that can be converted to a javascript value. (ToJSVal lives in GHCJS.Foreign.Marshal module in the ghcjs-base package.)

Numbers

int_ :: Int -> ReactElementM eventHandler () Source #

Format an integer using formattedNumber_ and the default style.

double_ :: Double -> ReactElementM eventHandler () Source #

Format a double using formattedNumber_ and the default style.

formattedNumber_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () Source #

A FormattedNumber which allows arbitrary properties and therefore allows control over the style and format of the number. The accepted properties are any options supported by Intl.NumberFormat.

formattedNumberProp Source #

Arguments

:: ToJSVal num 
=> JSString

the property to set

-> num

the number to format

-> [IntlProperty]

any options accepted by Intl.NumberFormat

-> PropertyOrHandler handler 

Format a number as a string, and then use it as the value for a property. int_, double_, or formattedNumber_ should be prefered because as components they can avoid re-rendering when the number has not changed. formattedNumberProp is needed if the formatted number has to be a property on another element, such as the placeholder for an input element.

Dates and Times

data DayFormat Source #

How to display a date. Each non-Nothing component will be displayed while the Nothing components will be ommitted. If everything is nothing, then it is assumed that year, month, and day are each numeric.

These properties coorespond directly the options accepted by Intl.DateTimeFormat.

Constructors

DayFormat 

Fields

  • weekdayF :: Maybe JSString

    possible values are narrow, short, and long

  • eraF :: Maybe JSString

    possible values are narrow, short, and long

  • yearF :: Maybe JSString

    possible values are numeric and 2-digit

  • monthF :: Maybe JSString

    possible values are numeric, 2-digit, narrow, short, and long

  • dayF :: Maybe JSString

    possible values are numeric and 2-digit

shortDate :: DayFormat Source #

A short day format, where month is "short" and year and day are "numeric".

day_ :: DayFormat -> Day -> ReactElementM eventHandler () Source #

Display a Day in the given format using the FormattedDate class and then wrap it in a HTML5 time element.

data TimeFormat Source #

How to display a time. Each non-Nothing component will be displayed while Nothing components will be ommitted.

These properties coorespond directly the options accepted by Intl.DateTimeFormat.

Constructors

TimeFormat 

Fields

shortDateTime :: (DayFormat, TimeFormat) Source #

A default date and time format, using shortDate and then numeric for hour, minute, and second.

utcTime_ :: (DayFormat, TimeFormat) -> UTCTime -> ReactElementM eventHandler () Source #

Display a UTCTime using the given format. Despite giving the time in UTC, it will be displayed to the user in their current timezone. In addition, wrap it in a HTML5 time element.

formattedDate_ :: Either Day UTCTime -> [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () Source #

A raw FormattedDate class which allows custom properties to be passed. The given Day or UTCTime will be converted to a javascript Date object and passed in the value property. The remaining properties can be any properties that Intl.DateTimeFormat accepts. For example, you could pass in "timeZone" to specify a specific timezone to display.

formattedDateProp Source #

Arguments

:: JSString

the property to set

-> Either Day UTCTime

the day or time to format

-> [IntlProperty]

Any options supported by Intl.DateTimeFormat.

-> PropertyOrHandler eventHandler 

Format a day or time as a string, and then use it as the value for a property. day_, utcTime_, or formattedDate_ should be prefered because as components they can avoid re-rendering when the date has not changed. formattedDateProp is needed if the formatted date has to be a property on another element, such as the placeholder for an input element.

dayToJSVal :: Day -> JSVal Source #

Convert a day to a javascript Date. This is useful to pass a date as a property to a message. Note that JSVal is an instance of ToJSVal so the result of dayToJSVal can be passed as a property via '(&=)'.

timeToJSVal :: UTCTime -> JSVal Source #

Convert a UTCTime to a javascript date object. This is useful to pass a time as a property to a message. Note that JSVal is an instance of ToJSVal so the result of timeToJSVal can be passed as a property via '(&=)'.

dayProp :: JSString -> Day -> IntlProperty Source #

Convert a day to a javascript date and set it as a property. This is primarily useful to be able to pass a date as a property to messageProp.

timeProp :: JSString -> UTCTime -> IntlProperty Source #

Convert a UTCTime to a javascript date and set it as a property. This is primarily useful to be able to pass a time as a property to messageProp.

Relative Times

relativeTo_ :: UTCTime -> ReactElementM eventHandler () Source #

Display the UTCTime as a relative time. In addition, wrap the display in a HTML5 time element.

formattedRelative_ :: UTCTime -> [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () Source #

Format the given UTCTime using the FormattedRelative class to display a relative time to now. The given UTCTime is passed in the value property. The supported style/formatting properties are "units" which can be one of second, minute, hour, day, month, or year and "style" which if given must be numeric.

formattedRelativeProp Source #

Arguments

:: JSString

te property to set

-> UTCTime

the time to format

-> [IntlProperty]

an object with properties "units" and "style". "units" accepts values second, minute, hour day, month, or year and "style" accepts only the value "numeric".

-> PropertyOrHandler eventHandler 

Format a time as a relative time string, and then use it as the value for a property. relativeTo_ or formattedRelative_ should be prefered because as components they can avoid re-rendering when the date has not changed. formattedRelativeProp is needed if the formatted date has to be a property on another element, such as the placeholder for an input element.

Plural

plural_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () Source #

A simple plural formatter useful if you do not want the full machinery of messages. This does not support translation, for that you must use messages which via the ICU message syntax support pluralization. The properties passed to plural_ must be value, and then at least one of the properties from other, zero, one, two, few, many.

pluralProp :: ToJSVal val => JSString -> val -> [IntlProperty] -> PropertyOrHandler eventHandler Source #

Format a number properly based on pluralization, and then use it as the value for a property. plural_ should be preferred, but pluralProp can be used in places where a component is not possible such as the placeholder of an input element.

Messages

type MessageId = Text Source #

An identifier for a message, must be globally unique.

message Source #

Arguments

:: MessageId 
-> Text

The default message written in ICU message syntax. This message is used if no translation is found, and is also the message given to the translators.

-> ExpQ 

Render a message and also record it during compilation. This template haskell splice produces an expression of type [PropertyOrHandler eventHandler] -> ReactElementM eventHandler (), which should be passed the values for the message. For example,

li_ ["id" $= "some-id"] $
    $(message "num_photos" "{name} took {numPhotos, plural, =0 {no photos} =1 {one photo} other {# photos}} {takenAgo}.")
        [ "name" $= "Neil Armstrong"
        , "numPhotos" @= (100 :: Int)
        , elementProperty "takenAgo" $ relativeTo_ (UTCTime (fromGregorian 1969 7 20) (2*60*60 + 56*60))
        ]

This will first lookup the MessageId (in this case num_photos) in the messages parameter passed to intlProvider_. If no messages were passed, intlProvider_ was not called, or the MessageId was not found, the default message is used.

In my project, I create a wrapper around message which sets the MessageId as the sha1 hash of the message. I did not implement it in react-flux because I did not want to add cryptohash as a dependency. For example,

import Crypto.Hash (hash, SHA1)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T

msg :: T.Text -> ExpQ
msg txt = message (T.pack $ show (hash (T.encodeUtf8 txt) :: Digest SHA1)) txt

message' Source #

Arguments

:: MessageId 
-> Text

A description indented to provide context for translators

-> Text

The default message written in ICU message syntax

-> ExpQ 

A variant of message which allows you to specify some context for translators.

messageProp Source #

Arguments

:: Text

the property name to set

-> MessageId

the message identifier

-> Text

the default message written in ICU message syntax.

-> ExpQ 

Similar to message, but produce an expression of type [IntlProperty] -> PropertyOrHandler handler, which should be passed the values for the message. This allows you to format messages in places where using a component like message is not possible, such as the placeholder of input elements. message should be prefered since it can avoid re-rendering the formatting if the value has not changed.

import Data.Aeson ((.=))

input_ [ "type" $= "numeric"
       , $(messageProp "placeholder" "ageplaceholder" "Hello {name}, enter your age")
             [ "name" .= nameFrom storeData ]
       ]

messageProp' Source #

Arguments

:: Text

property to set

-> MessageId 
-> Text

A description intended to provide context for translators

-> Text

The default message written in ICU message syntax

-> ExpQ 

A varient of messageProp which allows you to specify some context for translators.

htmlMsg Source #

Arguments

:: MessageId 
-> Text

default message written in ICU message syntax

-> ExpQ 

Similar to message but use a FormattedHTMLMessage which allows HTML inside the message. It is recomended that you instead use message together with elementProperty to include rich text inside the message. This splice produces a value of type [PropertyOrHandler eventHandler] -> ReactElementM eventHandler (), the same as message.

htmlMsg' Source #

Arguments

:: MessageId 
-> Text

A description intended to provide context for translators

-> Text

The default message written in ICU message syntax

-> ExpQ 

A variant of htmlMsg that allows you to specify some context for translators.

formattedMessage_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () Source #

A raw FormattedMessage element. The given properties are passed directly with no handling. Any message is not recorded in Template Haskell and will not appear in any resulting message file created by writeIntlMessages.

formattedHtmlMessage_ :: [PropertyOrHandler eventHandler] -> ReactElementM eventHandler () Source #

A raw FormattedHTMLMessage element. The given properties are passed directly with no handling. Any message is not recorded in Template Haskell and will not appear in any resulting message file created by writeIntlMessages.

Translation

data Message Source #

A message.

Constructors

Message 

Fields

Instances

writeIntlMessages :: (HashMap MessageId Message -> IO ()) -> Q [Dec] Source #

Perform an arbitrary IO action on the accumulated messages at compile time, which usually should be to write the messages to a file. Despite producing a value of type Q [Dec], no declarations are produced. Instead, this is purly to allow IO to happen. A call to this function should be placed at the bottom of the file, since it only will output messages that appear above the call. Also, to provide consistency, I suggest you create a utility wrapper around this function. For example,

{-# LANGUAGE TemplateHaskell #-}
module MessageUtil where

import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import React.Flux.Addons.Intl

writeMessages :: String -> Q [Dec]
writeMessages name = writeIntlMessages (intlFormatJson $ "some/diretory/" ++ name ++ ".json")

Note that all paths in template haskell are relative to the directory containing the .cabal file. You can then use this as follows:

{-# LANGUAGE TemplateHaskell #-}
module SomeViews where

import React.Flux
import React.Flux.Addons.Intl
import MessageUtil

someView :: ReactView ()
someView = defineView .... use $(message) in render ...

anotherView :: ReactView ()
anotherView = defineView ... use $(message) in render ...

writeMessages "some-views"

intlFormatJson :: FilePath -> HashMap MessageId Message -> IO () Source #

Format messages as json. The format is an object where keys are the MessageIds, and the value is an object with two properties, message and optionally description. This happens to the the same format as chrome, although the syntax of placeholders uses ICU message syntax instead of chrome's syntax. This does not pretty-print the JSON, but I suggest before adding these messages in source control you pretty print and sort by MessageIds so diffs are easy to read. This can be done with the aeson-pretty package, but I did not want to add it as a dependency.

intlFormatJsonWithoutDescription :: FilePath -> HashMap MessageId Message -> IO () Source #

Format messages as json, ignoring the description. The format is an object where the keys are the MessageIds and the value is the message string. This format is used by many javascript libraries, so many translation tools exist.

intlFormatAndroidXML :: FilePath -> HashMap MessageId Message -> IO () Source #

Format messages in Android XML format, but just using strings. String arrays and plurals are handled in the ICU message, instead of in the XML. There are many utilities to translate these XML messages, and the format has the advantage that it can include the descriptions as well as the messages. Also, the messages are sorted by MessageId so that if the output is placed in source control the diffs are easy to review.