Monday, April 13, 2009

Multilingual UI and dynamic language selection with hgettext

In the latest version of hgettext I implemented all capabilities, supported by standard gettext module. The only thing is left --- to avoid the unsafePerformIO in the code. Many haskers (Haskell hackers :) ) asked me to throw it away, and tried to help me with it, but I couldn't understood their solutions based on monads and monads transformers (yes, I'm only beginner in Haskell).

But the idea to remove unsafePerformIO from the code chased me all last week, and I tried to make program translation in more Haskell's style.

Of course, when we will not use unsafePerformIO our translation code will look like this:

>  __ :: String -> IO String
> __ = getText
> main = do
> s <- __ "Some translation message"
> putStrLn s

instead of:

>  __ :: String -> IO String
> __ = unsafePerformIO . getText
> main = do
> putStrLn (__ "Some translation message")

of course we could shorter it to:

>  __ :: String -> IO String
> __ = unsafePerformIO . getText
> main = do
> __ "Some translation message" >>= putStrLn

but, anyway, we have to type more code and put all translation into the IO monad.

So, I think, if we have a little drawback in typing when we internationalize Haskell apps, we should have benefits of using them. These benefits should be:

  1. possibility to switch between languages during the program execution

  2. ability to work with different translations simultaneously in the single proses (i.e. in different parts of code or different threads)

  3. should be some kind of notification to the rest program, that language is changed, to allow it redraw all visible elements on the screen

  4. support of Windows platform. I don't know how gettext works on Windows, but I am sure, that Haskell programmers shouldn't have any differences in build process on Linux or on Windows platforms.

Henning Thielemann proposed me to use monad transformers to implement these features, so I will try to follow his recommendations.

On this post, I'll try to show You how to implement the multilingual UI with runtime language switching. I think, these ideas will be implemented in the next hgettext releases.

All text below will be in literate Haskell, but complete sources with translation files you could download from Google code.

First of all import all libraries. We will build Gtk application.

> module Main where
> import Graphics.UI.Gtk hiding (get)
> import Text.Printf
> import Text.I18N.GetText
> import System.Locale.SetLocale
> import Codec.Binary.UTF8.String
> import Control.Monad.State
> import Control.Monad
> import Data.IORef

We will use State monad to store our translation state. Our translation state is currently selected language and translation function

> data TransState = TransState {
> transLanguage :: String,
> transFunction :: String -> IO String
> }

Now we will have only one trans function getText, but to use it in the Gtk application we have to decode string from UTF-8:

> getText' :: String -> IO String
> getText' s = getText s >>= return . decodeString

Lets introduce our Translation monad. It will build with StateT monad transformer and will contain our TransState:

> type Translation a = StateT TransState IO a 

So all our functions, which uses internationalization capabilities, should work under Translation monad.

Now, when all types are defined, we could write code from the main function:

> main :: IO ()
> main =
> do
> translator <- makeTranslator __MESSAGE_CATALOG_DOMAIN__ __MESSAGE_CATALOG_DIR__
> runWithLanguage "" translator gtkGUI

Note that __MESSAGE_CATALOG_DOMAIN__ and __MESSAGE_CATALOG_DIR__ are preprocessor definitions, and will be substituted with appropriate text only during cabal build (See the Configuring and install internationalized Haskell application)

makeTranslator simply wraps the bindTextDomain and textDomain functions and return the function which translate messages (in our case it is getText').

> makeTranslator domain dir =
> do
> bindTextDomain domain (Just dir)
> textDomain (Just domain)
> return getText'

runWithLanguage just run our gtkGUI function in the Translation monad:

> runWithLanguage locale translator code = 
> do
> result <- runStateT code (TransState locale translator)
> return $ fst result

gtkGUI has a type:

> gtkGUI :: Translation ()

and if we want to call function from the IO monad, we have to use liftIO.

Our Gtk application will have two similar panels, with different language settings on them. Window's title will be written in the default system language (could be changed with environment variable LANG). Panels will be initialized by English (left) and German (right).

> gtkGUI =
> do
> liftIO $ initGUI
> wndTitle <- __ "i18n Test"
> mainWindow <- liftIO $ do
> wnd <- windowNew
> set wnd [windowTitle := wndTitle]
> return wnd
> box <- liftIO $ hBoxNew False 0
> firstPanel <- withLanguage "en_US.UTF-8" $ constructPanel
> secondPanel <- withLanguage "de_DE.UTF-8" $ constructPanel
> mapM_ (\w -> liftIO $ boxPackStart box w PackNatural 10) [firstPanel, secondPanel]
> liftIO $ do
> containerAdd mainWindow box
> onDestroy mainWindow mainQuit
> widgetShowAll mainWindow
> mainGUI

I kept __ function, because it is very easy to mark all strings to translate by underscores, but now it takes translation function from the Translation monad:

> __ :: String -> Translation String
> __ str =
> do
> (TransState locale translator) <- get
> liftIO $ withLocale locale (translator str) (return str)

If we want to switch between the languages during the program execution and simultaneously use several languages, we will have to set locale to the proper value each time before we call our translator function. withLocale allow us to switch to the proper locale, run the code, and switch back to the previous locale setting.

> -- Sets locale to `locale`, executes the `action` and returns
> -- to previous local setting. Executes `err_action` when error
> -- occurred (in locale setting)
> withLocale :: String -> IO m -> IO m -> IO m
> withLocale locale action err_action =
> do
> mprevloc <- setLocale LC_MESSAGES Nothing
> (flip $ maybe err_action) mprevloc $ \prevloc ->
> do
> mthislocale <- setLocale LC_MESSAGES (Just locale)
> result <- maybe err_action (\_ -> action) mthislocale
> setLocale LC_MESSAGES (Just prevloc)
> return result

withLanguage is similar to runWithLanguage but it works in the Translation monad and sets only locale:

> withLanguage :: String -> Translation a -> Translation a
> withLanguage locale code =
> do
> (TransState locale' translator') <- get
> liftIO $ runWithLanguage locale translator' code

constructPanel creates very simple UI

> constructPanel =
> do
> localeEntry <- liftIO $ entryNew
> currentLocale >>= liftIO . entrySetText localeEntry
> localeButton <- liftIO $ buttonNew
> localeBox <- liftIO $ hBoxNew False 0
> mapM_ (\w -> liftIO $ boxPackStart localeBox w PackNatural 0)
> [toWidget localeEntry,
> toWidget localeButton]
> label <- liftIO $ labelNew Nothing
> entry <- liftIO $ entryNew
> label2 <- liftIO $ labelNew Nothing
> button <- liftIO $ buttonNew
> msgHandler <- liftIO $ onClicked button (return ()) >>= newIORef
> let translateActions = [
> __ "Set" >>= liftIO . buttonSetLabel localeButton,
> __ "Write down your name, please:" >>= liftIO . labelSetText label,
> __ "And than press button:" >>= liftIO . labelSetText label2,
> __ "Button" >>= liftIO . buttonSetLabel button,
> __ "Hello, %s, how are you?" >>= \s -> liftIO $
> do
> readIORef msgHandler >>= signalDisconnect
> onClicked button (clickAction entry s) >>= writeIORef msgHandler
> return ()]
> sequence_ translateActions
> translateClick <- fromTranslation $
> do
> locale <- liftIO $ entryGetText localeEntry
> withLanguage locale $
> sequence_ translateActions
> liftIO $ onClicked localeButton translateClick
> box <- liftIO $ vBoxNew False 0
> mapM_ (\w -> liftIO $ boxPackStart box w PackNatural 0)
> [toWidget localeBox,
> toWidget label,
> toWidget entry,
> toWidget label2,
> toWidget button]
> return box
> clickAction entry greet =
> do
> name <- entryGetText entry
> dialog <- messageDialogNew Nothing [DialogModal]
> MessageQuestion ButtonsOk (printf greet name)
> dialogRun dialog
> widgetDestroy dialog
> return ()
> currentLocale :: Translation String
> currentLocale = get >>= return . transLanguage

Here, to implement language switching, I grouped all locale specific actions in the one list, and execute it with sequence_. The only hard part --- is to reset previous message button handler and set new, with correct translation. I've used IORef here, but I think, there is better solution.

fromTranslation runs the new Translation monad with current settings and returns action in the IO monad:

> fromTranslation :: Translation a -> Translation (IO a)
> fromTranslation trans = get >>= return . evalStateT trans

When You try to run this application, you should see the following:

Than edit locale field and press button at the right side, you shoud see panel will redraw in the currently setted locale:

Yes, I know this code is not beautiful, it reflects my knowledge of Haskell at this moment. There are several questions to experienced haskellers:

  1. Are there possibility to avoid liftIO calling so many times ?

  2. How to make code which updates language string more clear and readable ? Are there some method to avoid IORef during creation internationalized message boxes ?

Friday, April 3, 2009

Configure and install internationalized Haskell application

My tutorial about internationalization of Haskell programs will not be complete without explaining how to configure and install Haskell package with internationalization support. Who tried all steps of previous tutorial could admit, that installation of localized data is very long, complex and boring routine, so there must be a way to simplify it (a Haskell way).

Now it is. From the version 0.1.5 of hgettext package, there is included module, that teaches Cabal to install language files.

So, download new hgettext and create for our hello program real world installer.

Directory structure

Currently we have following files:

The `hello` program itself.
Template file, which contain all strings to be translated. This file
should be included into the distribution to allow other users to
generate translation file for their language.
en.po, de.po
Translations to the English and German
languages. These files should be installed to the `locale` folder and
our program has to be able to find them (has to know where they going
to be installed)

Any other files could be generated from the previous, so they shouldn't be included to the distribution package.

Let's create the directory structure for our project. This is simple project, so directory structure should be simple too. Here it is:

| |
| |-messages.pot
| |-en.po
| |-de.po

Create install script

In order to create a cabal package, we have to add only two files. The first is hello.cabal:

Name:                   hello
Version: 0.1.3
Cabal-Version: >= 1.6

License: BSD3

Author: James Bond
Copyright: 2009 James Bond
Category: Hello

Synopsis: Internationalized Hello sample
Build-Type: Simple

Extra-Source-Files: po/*.po po/*.pot

x-gettext-po-files: po/*.po
x-gettext-domain-name: hs-hello

Executable hello
Main-Is: Main.hs
Hs-Source-Dirs: src
Build-Depends: base,hgettext >= 0.1.5, setlocale

This is standard .cabal file, but there we added two more lines:

Tells cabal where ar PO files to install
Sets the domain name, under which files will be installed 

For other details see documentation for hgettext Distribution.Simple.I18N.GetText module.

Note that we also enumerated *.po files in the extra-source-files section to add them to the distribution package.

The second file to create --- Setup.hs:

import Distribution.Simple.I18N.GetText

main = gettextDefaultMain

The gettextDefaultMain function substitutes the defaultMain function, but also adds several install hooks to the cabal package, to handle internationalization stuff.

Update the program code

So our installer knows where to put the *.po files and the domain name for them. Our code should know it too --- to make proper initialization. It is not Haskell way to duplicate same information twice, so let's modify the code to get the initialization parameters directly from the installer:

module Main where

import Text.Printf
import Text.I18N.GetText
import System.Locale.SetLocale
import System.IO.Unsafe

__ :: String -> String
__ = unsafePerformIO . getText

main = do
setLocale LC_ALL (Just "")

putStrLn (__ "Please enter your name:")
name <- getLine
printf (__ "Hello, %s, how are you?\n") name

So, the only lines were changed are:


Nice. __MESSAGE_CATALOG_DOMAIN__ and __MESSAGE_CATALOG_DIR__ are macro definitions, whose hold configured strings from the Cabal.

That's all?

Actually, yes. Now you could configure, build and install newly created package by invoking commands:

runhaskell Setup.hs configure
runhaskell Setup.hs build
runhaskell Setup.hs install

And test it.

Have a nice weekend :)

PS: Complete project tarball you can find here.