Wednesday, October 28, 2009

Asus WL500g Premium controller now on Windows

Today I worked on my WL500gPControl project, and already forced it to work on Windows. The most difficult parts were to set up the MinGW and build curl under it. To be honest, I ended up with precompiled curl library from Sigbjorn Finne.

To let others avoid these hardships, I prepared the binary version of WL500gPControl. You'll only have to unpack it on some directory, put the credentials file into the default placement and use it :). The binary version is here

Also I have added README file, where I described how to use this tool, so you shouldn't have any troubles with it.

If you are updating from previous version note that placement of the default file has been changed. For Unix users it is

$HOME/.WL500gPControl/credentials, 

and for Windows:

C:\Documents And Settings\user\Application Data\WL500gPControl\credentials

Tuesday, October 27, 2009

hs-ffmpeg now works from the box

hs-ffmpeg status.

Recently I have changed the way how hs-ffmpeg. Now the package finds libraries locations by itself.

So, if you have developer libraries for libavcodec, libavformat, libavutil and libswscale installed, you could simply put:

cabal update
cabal install hs-ffmpeg

And this will install ffmpeg bindings to your machine. (If don't, please, drop me issue in bug tracker).

Shortly, I've used autoconf to find ffmpeg libraries and its dependencies, and also added support for 0.51.0 versions of ffmpeg. I found that binary packages from my Ubuntu uses this version of library. Anyway, latest SVN versions of ffmpeg should also work.

ffmpeg-tutorials status

Another I found, that SDL bindings were updated to 0.5.6 version, and began conflict with my audio patch. So I created new audio patch for SDL-0.5.6. To apply it, just simply run following commands in the SDL-0.5.6 directory:

wget "http://hs-ffmpeg.googlecode.com/files/SDL-0.5.6-audio.patch"

patch -p1 < SDL-0.5.6-audio.patch

To do

  • I think to slightly rewrite the code with buffers and use ByteString instead. Don't know is it a good idea.

  • I continue working on tutorials, next step is to implement tutorial 04.

  • Also I want to make more functional approach to the video processing, i.e. represent the sequence of packets as list, or use Arrows to represent the decoding process.

Thursday, October 22, 2009

Working with databases in Haskell. Part 2

Here I want to describe how I deal with tagged document storage in Haskell, using the relational database sqlite3 (through HDBC). Yes, I know, that relational database work very poor with document-oriented and tagged data, but for a little amount of data it could be the proper way to implement storage.

The following code works with databases in the same way as described in my previous post, and written in literate Haskell style, so you can easily save it in the some_file.lhs, load it in ghci and play with database.

Task description

Let’s suppose we have to store documents with following properties:

  • author — the string, representing the author
  • title — document’s title
  • body — the content of the document
  • list of tags — tags, assigned to the documents

All parameters will be Strings for simplicity, and we will not put any restrictions to the tags format.

The most obvious way to store these data is to use single table with separate fields for each property. But how to deal with tags? Document could have any amount of tags, or have nothing. We couldn’t create a table with infinite columns. Other solution, is to store all tags in one text field, and represent them as comma-separated lists, but in this case we have to put some restrictions to the tags (e.g. they shouldn’t hold commas) and each query involves different string matching and string updating, which should be done on client side, and those not efficient.

But there is the third way. We, along with the database gurus, will use many-to-many relation to represent tagged documents.

Begin to code


> import Database.HDBC
> -- we will use sqlite3 driver here
> import Database.HDBC.Sqlite3
> import Control.Monad (liftM, when)
> -- all our database code will be enclosed in ReaderT monad
> -- see previous post for details
> import Control.Monad.Reader
> import Data.Maybe
> import Control.Applicative

Define the internal Haskell types, from/to which we will serialize data:


> type TagList = [String]
>
> data Document = Doc {
> author :: String
> , title :: String
> , content :: String
> } deriving (Eq, Show)
>
> -- Our transaction type
> type Transact a = ReaderT Connection IO a

Define some helper functions to work with database and the function that runs our transaction monad


> -- Get database connection object
> conn :: Transact Connection
> conn = ask
>
> -- Query the database without result (update queries)
> query :: String -> [SqlValue] -> Transact ()
> query q v = do
> c <- conn
> liftM (const ()) $ liftIO $ run c q v
>
> -- Query the database with returning result
> query' :: String -> [SqlValue] -> Transact [[SqlValue]]
> query' q v = do
> c <- conn
> liftIO $ quickQuery' c q v
>
> -- Run the transaction
> runTransact :: String -> Transact a -> IO a
> runTransact dbname io = do
> c <- connectSqlite3 dbname
> runReaderT withCommit c
> where
> withCommit = do
> result <- io
> conn >>= liftIO . commit
> return result

OK, all preparations are done, now start implementing the core of our document data-store.

In order to implement many-to-many relation, we have to create three tables: one for documents, one for tags and one is relation between tags and documents.

Creating databases


> -- Create tables
> createDocumentsTbl =
> query "CREATE TABLE documents ( \
> \docid INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, \
> \author TEXT NOT NULL, \
> \title TEXT NOT NULL, \
> \content TEXT NOT NULL, \
> \UNIQUE (author, title, content))" []
>
> createTagsTbl =
> query "CREATE TABLE tags ( \
> \tagid INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, \
> \tag TEXT NOT NULL UNIQUE )" []
>
> createDocTagsTbl =
> query "CREATE TABLE doctags ( \
> \docid INTEGER, \
> \tagid iNTEGER, \
> \PRIMARY KEY (docid, tagid), \
> \FOREIGN KEY (docid) REFERENCES documents (docid), \
> \FOREIGN KEY (tagid) REFERENCES tags (tagid))" []
>
> -- Checks whether tables created, and create them otherwise
> initializeDb = do
> tables <- conn >>= liftIO . getTables
> mapM_ (\(tn,cf) -> when (tn `notElem` tables) cf)
> [("documents", createDocumentsTbl)
> ,("tags", createTagsTbl)
> ,("doctags", createDocTagsTbl)]

Now you can load this file to the ghci and execute:

runTransact "test.db" initializeDb

then check the database with sqlite3 test.db command and see, that all tables were successfully created.

Low-level access to the databases

Lets start implementing basic functions to work with our documents:


> -- Adds new tag to the database, do nothing if tag exists
> addTag tag =
> query "INSERT OR IGNORE INTO tags (tag) VALUES (?)"
> [toSql tag]
>
> -- Finds tag by name, returns id or Nothing
> findTag tag =
> liftM (idListToMaybe) $
> query' "SELECT tagid FROM tags WHERE tag = ?" [toSql tag]
>
> -- Return tag name by id
> getTag tagid =
> liftM (fmap (fromSql . head) . listToMaybe) $
> query' "SELECT tag FROM tags WHERE tagid = ?" [tagid]
>
> -- Remove tag from database
> removeTagById tagid =
> query "DELETE FROM tags WHERE tagid = ?" [tagid]
>
> -- Find document by name, author and content. Return docid or Nothing
> findDocument doc =
> liftM (idListToMaybe) $
> query' "SELECT docid FROM documents \
> \WHERE author = ? AND title = ? AND content = ?" $
> docToSqlValue doc [author, title, content]
>
> -- Adds new document document to the database
> addDocument doc =
> query "INSERT OR IGNORE INTO documents (author, title, content) \
> \VALUES (?,?,?)" $ docToSqlValue doc [author, title, content]
>
> -- Return document by id
> getDocument docid =
> liftM (listToDocument) $
> query' "SELECT author, title, content FROM documents \
> \WHERE docid = ?" [docid]
>
> -- Remove document from the database
> removeDocumentById docid =
> query "DELETE FROM documents WHERE docid = ?" [docid]
>
> -- Adds link between document and tag
> addLink docid tagid =
> query "INSERT OR IGNORE INTO doctags VALUES (?, ?)" $
> [docid, tagid]
>
> -- Remove link between document and tag
> removeLinkById docid tagid =
> query "DELETE FROM doctags WHERE docid = ? AND tagid = ?" $
> [docid, tagid]
>
> -- Get tags for document, returns list of tagids
> getDocumentTagsById docid =
> liftM (map head) $
> query' "SELECT tagid FROM doctags WHERE docid = ?" [docid]
>
> -- Get document ids for the tag id
> getTaggedDocumentsById tagid =
> liftM (map head) $
> query' "SELECT docid FROM doctags WHERE tagid = ?" [tagid]
>

High-level functions to work with data

So the basic functions, that create separate entities in the database are implemented, now we could use that functions to combine high-level operations:


> -- Adds new tag and return its id, or simply return id if tag exists
> -- we used fromJust here, because tag should exists
> addTag' tag = addTag tag >>
> (liftM fromJust $ findTag tag)
>
> -- Adds new document and its id, or simply return id if document exists
> addDocument' doc = addDocument doc >>
> (liftM fromJust $ findDocument doc)
>
> -- Adds complete document with tags
> addCompleteDocument doc tags = do
> docid <- addDocument' doc
> tagids <- mapM addTag' tags
> mapM_ (addLink docid) tagids
> return docid
>
> -- Get document tag names
> getDocumentTagNames docid = do
> tags <- getDocumentTagsById docid
> liftM catMaybes $ mapM getTag tags

And so on. By the way, last function getDocumentTagNames we could also implement as a single SQL query, using JOIN:


> -- Similar to `getDocumentTagNames` but implemented
> -- through SQL JOINs
> getDocumentTagNames' docid = do
> liftM (map (fromSql . head)) $
> query' "SELECT tag \
> \FROM tags LEFT JOIN doctags USING (tagid) \
> \WHERE docid = ?" [docid]

And finally, some helper functions, used before:


> -- Converts select result into Just v or Nothing
> idListToMaybe = fmap head . listToMaybe
>
> -- Converts Document structure to SqlValue list,
> -- the second argument - list of fields to convert
> docToSqlValue doc = map (toSql . ($ doc))
>
> -- Converts the list of SqlValues to the document
> listToDocument = fmap (toDoc . map fromSql) . listToMaybe
> where
> toDoc [a,b,c] = Doc a b c
> toDoc _ = Doc "" "" ""

Conclusion

I have just demonstrated how is easy to work with databases in Haskell, and also showed the basic principles of storing tagged documents, which is very important in the WEB (and often in desktop) applications.

The code is clearer than the code on Visual Basic or Delphi (from my memoirs) and simpler than code on Python. And I think this proves that Haskell is very good for real world applications.

Databases in Haskell or "Release the power of monad transformers"

Many years ago almost all my programs were ‘some kind of interface to database’. I have been programming on C/C++ so work with databases was simple and required a lot of stupid code.

Several days ago I returned to the databases but now with Haskell in my hands and functional-oriented mind in my head :). First time I coded in the C-style from Haskell, but now, I think, I have found more functional way to work with databases. Of course this approach is not universal, and database ninjas could blame me for it, but let me continue :).

Combining transactions with monad transformers

I worked with sqlite3 database, but this approach should work with other databases too.

I enclosed all my database code into ReaderT monad in the following way:

> import Database.HDBC
> import Control.Monad
> import Control.Monad.Reader
>
> type DbTransaction a = ReaderT Connection IO a
>
> -- return the connection from the reader monad
> conn :: DbTransaction Connection
> conn = ask
>
> -- some useful functions to work with databases
>
> -- query function executes simple query without returning any results
> -- useful for create table and update queries
> query :: String -> [SqlValue] -> DbTransaction ()
> query q v = do
> c <- conn
> liftM (const ()) $ liftIO $ run c q v
>
> -- query' function executes query with results (for select queries)
> query' :: String -> [SqlValue] -> DbTransaction [[SqlValue]]
> query' q v = do
> c <- conn
> liftIO $ quickQuery' c q v

From that moment we can create our own queries like following:

-- get the user id from the database
> getUserId :: String -> DbTransaction (Maybe String)
> getUserId name =
> liftM (maybeId) $ query' "SELECT id FROM users WHERE name = ?" [toSql name]
> where maybeId [] = Nothing
> maybeId [[id]] = Just $ fromSql id

-- add new article to the database
> addArticle :: String -> String -> String -> DbTransaction ()
> addArticle user_id title content =
> query "INSERT INTO (user_id, title, body) VALUES (?,?,?)" $
> map toSql [user_id, title, content]

Also we can combine all our actions under one big transaction, i. e. take a user name and article title and body, add article with user id:

> addArticle :: String -> String -> String -> DbTransaction ()
> addArticle user title content = do
> uid <- getUserId user
> when (isJust uid) $ do
> addArticle (fromJust uid) title content

Now we have to explore how to run our transactions from the main program. I designed the function that takes the database name, connects to it, runs the transaction and commits everything:

> runTransaction :: String -> DbTransaction a -> IO a
> runTransaction dbname io = do
> c <- connectSqlite3 dbname
> runReaderT withCommit c
> where
> withCommit = do
> result <- io
> conn >>= liftIO . commit
> return result

So each time we need to query database, we will do the following:

> runTransaction "mydb.db" $ 
> addArticle "Hamlet" "The Question" "To be or not to be"

Don’t know how are you, but I like this code. It is short, clear, database-dependent code wrote in the separate monad and couldn’t be randomly combined with other code, and also safe. If you will want to use another database interface, you only will have to change one function (runTransaction).

It is easy to add error handling to this code. Here is two ways:

  • wrap the DbTransaction into the ErrorT monad, and wrap all HDBC functions to re-throw exceptions, or

  • use the internal HDBC exception handling mechanism (default behavior)

Anyway, this is only one example how to use monad transformers in real life, even for small projects. In the next posts I’ll show another uses of this approach.

Thursday, October 15, 2009

Control your ASUS WL500g Premium from the command line

I have a nice router Asus WL500g Premium, but I can’t say the same about my Internet provider. Several times a day it breaks the Internet connection in the way my router couldn’t restore it, so I have to manually disconnect and re-connect it. This is tremendously hard because of poor router’s admin interface. So, because I’m still learning Haskell, I decided to create simple command-line utility that will reconnect my router to the WAN.

After first release, I split the project into two components: a library, which connects to the router, and several command-line tools, that runs my usual activities automatically. You can install them using cabal:

cabal install WL500gPLib
cabal install WL500gPControl

The WL500gP Library now could retrieve connection status, external IP address, DNS servers and log from the router, and could send connect, disconnect and clear log commands. I implemented all these operations in the Conn monad, which is simply Reader transformer over IO monad. This approach reduces boilerplate code and also adds automatic log off to the command chain.

The WL500gP Remote Control package have two executables, to work with router. WL500gPControl does everything, that library support. So to see log from the router, simply run:

WL500gPControl -l

To see all list of supported operations type:

WL500gPControl -h

The connection info (user name, password and host address) WL500gPControl takes from the $HOME/.wl500gp file, but it could be any other file specified in the command line as the second argument. The file format is following:

user: username
password: password
host: 192.168.1.1

The second script is very simple and I wrote it only to show connection status in my xmobar. It only prints connected or disconnected with color tags (green and red accordingly). Here is my config line from .xmobarrc:

Run Com "WL500gPStatus" ["-c", "$HOME/.wl500gp"] "Internet" 300

Conclusion

It took several hours to implement all these features, and from that time I never loaded my router’s admin page. And also I ensured that tagsoup is the great library for fast and dirty HTML parsing.

Video processing on Haskell - easy

Almost all my past jobs were in the field on video processing, creating custom filters, decoders and encoders. Several of these jobs were to implement complete video/audio players. I’ve used ffmpeg library to perform all these tasks, except once I’ve used GStreamer. I can’t say that GStreamer is bad, but it didn’t allow me to completely control the decoding process, stucks on malformed video files and it was really painful to develop the 24x7 application.

And I returned to ffmpeg again, but than I became a haskeller :) so the idea was to made ffmpeg closer to Haskell community. Today let me introduce the hs-ffmpeg library for haskell.

Current version (0.3.2) supports basic file opening, streams enumerating, video and audio decoding. To make the process more interesting I took FFMpeg and SDL tutorial and implemented bindings in the sequence they are appeared in this tutorial. The second project, that shows how to use hs-ffmpeg and implements tutorials is ffmpeg-tutorials. It depends on SDL, so I’ve used Haskell SDL bindings to work with video and audio.

Several notes on building the sources.

Building hs-ffmpeg

You have to change hs-ffmpeg.cabal file to tune your ffmpeg library settings. In my case, ffmpeg installed under /usr/local tree, so my include dirs have /usr/local/include line and extra-lib-dirs contains /usr/local/lib value. Also in the extra-libraries you should specify the complete list of libraries, against which your version of ffmpeg have been buit.

If you do everything right, than hs-ffmpeg will build without any errors.

Patching the SDL

If you want to run ffmpeg-tutorials (sure you want :)), than you have to patch SDL bindings first. Current SDL bindings version is 0.5.5, and I’ve created SDL audio patch to this version, so do the following:


cabal fetch SDL
cd /tmp
tar xzvf ~/.cabal/packages/hackage.haskell.org/SDL/0.5.5/SDL-0.5.5.tar.gz
cd SDL-0.5.5
wget http://hs-ffmpeg.googlecode.com/files/SDL-0.5.5-audio.patch
patch -p1 < SDL-0.5.5-audio.patch


Than configure and build bindings. (Note: you’ll have to install SDL development libraries on to your system).

Running ffmpeg-tutorials

Currently only three tutorials are implemented. tutorial03 is completely showing capabilities of ffmpeg in video and audio decoding. Just simply run it with video fil ename as an argument to see how it decodes and shows video and plays sound.

Future work

I have only started this work, but I’d glad to hear comments and suggestions from people who interested in video processing on Haskell.

My future work plans are splitted onto several parts:

  • Continue implementing bindings to ffmpeg library

  • Improve build system, profiling

  • Started with multimedia combinators library, to program video and audio applications in more functional way (it is my dream)

Credentials:

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:

Main.hs
The `hello` program itself.
messages.pot
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:

hello\
|
|-po\
| |
| |-messages.pot
| |-en.po
| |-de.po
|
|-src\
|
|-Main.hs

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
Maintainer: James.Bond@MI6.bi
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:

x-gettext-po-files
Tells cabal where ar PO files to install
x-gettext-domain-name
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 "")
bindTextDomain __MESSAGE_CATALOG_DOMAIN__ (Just __MESSAGE_CATALOG_DIR__)
textDomain __MESSAGE_CATALOG_DOMAIN__

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

So, the only lines were changed are:

  bindTextDomain __MESSAGE_CATALOG_DOMAIN__ (Just __MESSAGE_CATALOG_DIR__)
textDomain __MESSAGE_CATALOG_DOMAIN__

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.

Saturday, March 28, 2009

hgettext on Hackage

I've got access to the Haskell.org and Hackage, so now you could get hgettext package from Hackage by typing

cabal install --global hgettext

There is also a wiki page about internationalization of Haskell applications on the Haskell.org

In future only wiki and Hackage will contain most recent versions of hgettext library and documentation.

Friday, March 27, 2009

I18n and Haskell

I18n and Haskell

The first things I tried to code in Haskell were UI programs with Gtk and several console tools. It was the opposite approach to the one usual for learning Haskell; Haskellers mostly learn the language by solving hard algorithmic tasks. So my first problem was not about understanding monads, but to use UTF-8 in the code and to create multilingual interfaces.

The first of those problems seems to have been solved already (though I'd like to see native UTF-8 support in Haskell). But the second is not. Today I'll try to fill the gap in the internationalization (also known as i18n) of the Haskell programs.

The approach I'll talk about is based on GNU gettext utility. All my experience on this utility is taken from internationalizing Python applications. So I adapted this experience to the Haskell world.

Let's start with an example. Suppose that we want to make the following program multilingual:

module Main where

import IO

main = do
putStrLn "Please enter your name:"
name <- getLine
putStrLn $ "Hello, " ++ name ++ ", how are you?"

Using these recomendations, prepare strings and wrap them to some 'translation' function '__':

module Main where

import IO
import Text.Printf

__ = id

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

We will return to the definition of '__' a bit later; for now we will leave the function empty (id).

The next step is to generate a POT file (a template which contains all strings to needed to be translated). For Python, C, C++ and Scheme there is the xgettext utility, but it doesn't support Haskell. So I created simple utility, that does the same thing for haskell files --- hgettext. You could find it on Hackage.

Now, from the directory that contains your project, run this command:

hgettext -k __ -o messages.pot Main.hs

It will gather all strings containing the function '__' from the Main.hs and write everything to messages.pot.

Now look at the resulting pot file:


# Translation file

msgid ""
msgstr ""

"Project-Id-Version: PACKAGE VERSION\n"
"Report-Msgid-Bugs-To: \n"
"POT-Creation-Date: 2009-01-13 06:05-0800\n"
"PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n"
"Last-Translator: FULL NAME <EMAIL@ADDRESS>\n"
"Language-Team: LANGUAGE <LL@li.org>\n"
"MIME-Version: 1.0\n"
"Content-Type: text/plain; charset=UTF-8\n"
"Content-Transfer-Encoding: 8bit\n"

#: Main.hs:0
msgid "Please enter your name:"
msgstr ""

#: Main.hs:0
msgid "Hello, %s, how are you?\n"
msgstr ""

We are interested in the last part of this file -- the parts beginning with #: Main.hs:.... Each is followed by a pair of lines beginning with msgid and msgstr. msgid is the original text from the code, and msgstr is the translated string. Each language should have its own translation file. I will create two translations: German and English.

To create a PO file for specific locale we should use the msginit utility.
To generate the German translation template run:

msginit --input=messages.pot --locale=de.UTF-8

And for English translations run:

msginit --input=messages.pot --locale=en.UTF-8

If we look at the generated files (en.po and de.po), we will see that English translation is completely filled, only the German PO file needs to be edited. So we fill it with following strings:

#: Main.hs:0
msgid "Please enter your name:"
msgstr "Wie heißen Sie?"

#: Main.hs:0
msgid "Hello, %s, how are you?\n"
msgstr "Hallo, %s, wie geht es Ihnen?\n"

Now we have to create directories where these translations should be placed. Originally all translation files are placed in the folder /usr/share/locale/ , but you are free to select a different place. Run:

mkdir -p {de,en}/LC_MESSAGES

This will create two sub-directories 'de' and 'en', each containing LC_MESSAGES, in the current directory. Now we use the msgfmt tool to encode our po files to mo files (binary translation files):

msgfmt --output-file=en/LC_MESSAGES/hello.mo en.po
msgfmt --output-file=de/LC_MESSAGES/hello.mo de.po

Ok, now the preparatory tasks are done. The final step is to modify the code to support the internationalization:

module Main where

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

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

main = do
setLocale LC_ALL (Just "")
bindTextDomain "hello" "."
textDomain "hello"

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

Here we added three initialization strings:

setLocale LC_ALL (Just "")
bindTextDomain "hello" "."
textDomain "hello"

You'll have to download the setlocale package to enable the first function: it sets the current locale to the default value. The next two functions tell gettext to take the "hello.mo" message file from the locale directory (I set it to ".", but in general case, this directory should be passed from the package configuration).

The final step is to define the function '__'. It simply calls getText from the module Text.I18N.GetText. Its type is String -> IO String so I used unsafePerformIO to make it simpler the. The GetText library was written by me, so maybe in the future it will be possible to implement a version of getText which will work outside the IO monad.

Now you can build and try the program in different locales:

user> ghc --make Main.hs
[1 of 1] Compiling Main ( Main.hs, Main.o )
Linking Main ...

user> LOCALE=en_US.UTF-8 ./Main
Please enter your name:
Bond
Hello, Bond, how are you?

user> LOCALE=de_DE.UTF-8 ./Main
Wie heißen Sie?
Bond
Hallo, Bond, wie geht es Ihnen?

user>

That's all :), really it was much simpler than writing this blog entry. I hope this article will be helpful for you.

PS: hgettext is on Hackage now

PPS: Thanks to Michael Thompson, who corrected my poor English :)

Less code - more functionality

Yesterday I tried to implement one "simple" function. It should take a Haskell source and return a list of all parameters to the function
abc :: String->String
E.g. for the part of code:


xy = (abc "hello") ++ (abc "world")

main = do putStrLn (abc "hi")
putStrLn xy
putStrLn (abc "bye")



output should be:
["hello", "world", "hi", "bye"]


Haskell has library Language.Haskell.Parser to parse its own source files, but the output has very complex structure. For example, previous part of code, will be represented like:


(HsModule (SrcLoc {srcFilename = "", srcLine = 1, srcColumn = 1})
(Module "Main") (Just [HsEVar (UnQual (HsIdent "main"))]) []
[HsPatBind (SrcLoc {srcFilename = "", srcLine = 1, srcColumn = 1})
(HsPVar (HsIdent "xy")) (HsUnGuardedRhs (HsInfixApp (HsParen (HsApp (HsVar (UnQual
(HsIdent "abc"))) (HsLit (HsString "hello")))) (HsQVarOp (UnQual (HsSymbol "++")))
(HsParen (HsApp (HsVar (UnQual (HsIdent "abc"))) (HsLit (HsString "world")))))) [],
HsPatBind (SrcLoc {srcFilename = "", srcLine = 3, srcColumn = 1})
(HsPVar (HsIdent "main")) (HsUnGuardedRhs (HsDo [HsQualifier (HsApp (HsVar
(UnQual (HsIdent "putStrLn"))) (HsParen (HsApp (HsVar (UnQual (HsIdent "abc")))
(HsLit (HsString "hi"))))),HsQualifier (HsApp (HsVar (UnQual (HsIdent "putStrLn")))
(HsVar (UnQual (HsIdent "xy")))),HsQualifier (HsApp (HsVar (UnQual (HsIdent "putStrLn")))
(HsParen (HsApp (HsVar (UnQual (HsIdent "abc"))) (HsLit (HsString "bye")))))])) []])


Ugghhhh, looks terrible. The straightforward way to solve my task is to write a bunch of functions that will parse all datatypes, until they extract something like
(HsApp (HsVar (UnQual (HsIdent "abc"))) (HsList (HsString s)))
Maybe it simplier to regexp through haskell code?

No, and let me introduce TemplateHaskell. I haven't used it yet, but heard, that it is very powerfull part of the Haskell. It works like C++ Templates or macros, i.e. during program compilation. On the Haskell-Cafe Neil Mitchel pointed me to the use uniplate generic library. Without deep explorations and understanding how it work, I wrote a one-line function that solves my problem:


getParamList hscode= [x |
HsApp (HsVar (UnQual (HsIdent "abc"))) (HsList (HsString x)) <-
universeBi (parseModule hscode)]


A really brilliant result. Even beginner haskeller could easily understand what is happen here.

PS: It is amazing how fast and helpful haskell community is. Thank you guys :)