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 ?

1 comment:

  1. Hrmm, one design spaceoption might be to employ the OverloadedStrings extension to eliminate the __ method.

    But then, having IO String have different semantics than String is probably sufficiently weird that I'd want a newtype wrapper, so I guess you'd be drowning in noise from unwrapping the newtype, if not from the translation calls.

    ReplyDelete