Exploring internationalization (i18n) in Haskell (message translations, datetime format, number/currency format)

en.msg

-- @messages/en.msg
Hello: Hi there!
SayAge age@Int: Your age is: #{show age}
DisplayPrice price@T.Text: This product costs #{price}

fr.msg

-- @messages/fr.msg
Hello: Salut!
SayAge age: Ton age est: #{show age}
DisplayPrice price: Ce produit coûte #{price}

Main.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE DeriveGeneric         #-}

module Main where

import Data.Monoid ((<>))
import qualified Data.Text as T
import Text.Shakespeare.I18N (mkMessage, renderMessage, RenderMessage())

data App = App

mkMessage "App" "messages" "en"

data Locale =
    EN
  | FR
  deriving (Show, Eq)

toISOLocale :: Locale -> T.Text
toISOLocale EN = "en"
toISOLocale FR = "fr"

data Currency =
    USD
  | EUR
  deriving (Show, Eq)

data NumberFormat =
  DefaultNumberFormat
  deriving (Show, Eq)

renderCurrency :: (RenderNumber a) => NumberFormat -> Locale -> Currency -> a -> T.Text
renderCurrency numberFormat locale currency value =
  let formattedValue = renderNumber numberFormat value
  in placeCurrencySymbol locale currency formattedValue

placeCurrencySymbol :: Locale -> Currency -> T.Text -> T.Text
placeCurrencySymbol EN = placeCurrencySymbolLeft EN
placeCurrencySymbol FR = placeCurrencySymbolRight FR

placeCurrencySymbolLeft :: Locale -> Currency -> T.Text -> T.Text
placeCurrencySymbolLeft locale currency formattedValue =
  (currencySymbol currency locale) <> formattedValue

placeCurrencySymbolRight :: Locale -> Currency -> T.Text -> T.Text
placeCurrencySymbolRight locale currency formattedValue =
  formattedValue <> " " <> (currencySymbol currency locale)

currencySymbol :: Currency -> Locale -> T.Text
currencySymbol USD FR = "$US"
currencySymbol USD _ = "$"
currencySymbol EUR _ = "€"

class RenderNumber a where
  renderNumber :: NumberFormat -> a -> T.Text

instance RenderNumber Int where
  renderNumber _ value = T.pack (show value)

renderMsg :: (RenderMessage a b) => a -> Locale -> b -> T.Text
renderMsg master locale message =
  renderMessage master [(toISOLocale locale)] message

main :: IO ()
main = do
  let price = renderCurrency DefaultNumberFormat EN USD (12 :: Int)
  let msg = renderMsg App EN (MsgDisplayPrice price)
  putStrLn (T.unpack msg)
  let price' = renderCurrency DefaultNumberFormat FR USD (12 :: Int)
  let msg' = renderMsg App FR (MsgDisplayPrice price')
  putStrLn (T.unpack msg')

output

This product costs $12
Ce produit coûte 12 $US