Programs and programming

The Toilet Paper Entrepreneur. Not a review

2011-07-11T12:59:00.000-07:00

Many years ago I was fascinated with ideas shared by Robert Kiyosaki and others, that everyone could be a millionaire. The only is needed is to think that you’re already a millionaire and action accordingly.

That was easy. Only several hours a day, dreaming how would I spend my millions on yachts, helicopters, restaurants and all my dreams become true soon.

Yes this is bullshit, but for first-year student this looked very cool along with the fact, that book authors looked rich and successful people. By the way, I haven't spent much time on practicing this, because I was busy with other things, that fascinated me more - programming, studying, family. But I still know some people who believe in this, and still sometimes invite me to "dream together".

Ok, most of them, who believed in the easy money grove, went for work, gathering money, playing with children and ensured that there is no easy money. Each work or business requires much of efforts, nerves etc. If you want to get more money, than prepare to greater responsibility, or greater risk or both. Anyway, you'll have less time to sleep or to play with kids.

"But what about these lucky guys, from all these books? What about Page and Brin? Zukerberg? Other millionaires?" You'll ask. The answer is: "They're lucky, dude". Yes, they belong to the small number of population, we kindly name "lucky pants". I'm very happy these people exist and do cool stuff I'm using, but they couldn't act as examples. They're represent only 0.0001% of all businesses. Next 2-5% are ordinary businesses with ordinary income and 95% businesses are failed, or in a way of failing.

Anyway, I like to read books and when "The Toilet Paper Entrepreneur" comes through my eyes, I’ve decided to look on it.

To be shortly, this book left concurrent feelings. The good are that it is not big and reads easily. Also the author tells about hard way to success, contrary with previous dreaming-based methods. He also give there some fresh tips on how to start business without initial funding, how to keep away from angels and VCs on startup. There are also many tips on how to spend less or no money on advertising, web page, conference calls etc.

In the same time Mike presented a new population of entrepreneurs - TPE. But I don’t wannabe TPE, I just want to do what I like and get paid for it. And I don't think this book will create new move - TPE move.

Also, appealing to the lucky businesses and "The Secret" movie, left feeling that this book continues series of "Homebrew millionaire. Made easy" books, about which I have strong disagreement. Yep, believing in success should be present in all entrepreneurs, but pragmatic view should dominate.

I don't miss I've read this book; it has many interesting advices, and tends to be real. Also it prepares you to a hard way if you'll choose to be an entrepreneur. And not only toilet paper entrepreneur :)

Installing gtk2hs 0.12 for the latest Haskell Platform on the Windows 7

2011-04-17T00:56:00.000-07:00

This post only comments the original tutorial from haskell.org and describes extra action, one should perform to successfully install the Gtk bindings to Haskell without MinGW.

So, steps, you should perform:

Read the original documentation on how to install Haskell for Windows

Download all required files, mentioned im this document

Install the Gtk to the location without spaces in the filenames. So the default location (C:\Program Files\Gtk+) won't work.

Run command-line prompt, fill the INCLUDE and PKG_CONFIG_PATH with correct paths to Gtk+ and libxml2.

run cabal install --ghc-option=-DCABAL_VERSION_MINOR=10 gtk

This is not all.

Now, some packages fails to register with error:

Registering cairo-0.12.0...
setup.exe: internal error: unexpected package db stack: [UserPackageDB]

This is because of bug (or mistake?) in Gtk2hsSetup.hs. So for these packages you should unpack them (e.g. cabal unpack cairo), move to the unpacked directory and change the following code in the Gtk2hsSetup.hs (line 199 of the file):

#if CABAL_VERSION_CHECK(1,10,0)
        installedPkgInfo pkg lbi inplace [packageDb]
#else
        installedPkgInfo pkg lbi inplace packageDb
#endif

#if CABAL_VERSION_CHECK(1,10,0)
        installedPkgInfo pkg lbi inplace (withPackageDB lbi)
#else
        installedPkgInfo pkg lbi inplace packageDb
#endif

Than, in the package root directory type:

cabal install --ghc-option=-DCABAL_VERSION_MINOR=10

Other errors I've faced with, and the solutions

Error in compiling `pango` package, the compiler couldn't find `glib/glib.h` file.

In the file pango-0.12.0\Graphics\Rendering\Pango\Struts.hsc change

#include <glib/glib.h>

#include <glib.h>

Error in compiling `gio` package, some names aren't defined (`wmDriveStopButton`, `DriveStartStopType`, `DriveStartFlags`)

This is because in the module exports these names are present, but defined in a body with macro:

#if GLIB_CHECK_VERSION(2,22,0)
...
#endif

My solution, is to wrap the definitions of these exports in the same macro. Fortunately this will not break the compilation.

After all these steps you should have a working installation of the Gtk2Hs. To check this, you could build and run examples from the gtk-0.12.0\demo directory.

Released new version of ProjectTemplate. Now on Windows.

2010-05-29T10:35:00.000-07:00

Recently I've uploaded new, more powerful version of my ProjectTemplate tool. Now it could create from templates single files, and don't require the project directory to be created. More info in the README file.

Also I've added support for Windows. It is not so beauty as for Linux platforms (on Windows it works without realine functionality). The Windows binaries are stored on Google Code.

Ironically, but ProjectTemplate helps me more in C++ coding, not in Haskell ;)

On creating Haskell projects. Cabal init.

2010-03-09T11:20:00.000-08:00

In comments to my previous article on reddit I read about new feature in the cabal-install package (version 0.8.0) - cabal init. This is more convenient successor for mkcabal and I glad it now seamlessly integrated to this powerful project management tool.

This tool also supports rich command line interface, to avoid entering some common properties (such as license, version etc.) every time.

ProjectTemplate - a template-based tool for creating Haskell projects

2010-03-05T01:41:00.001-08:00

Yesterday I created 5 projects, and found many boilerplate code on preparing cabal files, Setup.hs and directory structure. So I decided to simplify project creation for haskellers and created ProjectTemplate.

I was inspired by the Don’s mkcabal tool, and created the similar dialog-based application.

mkcabal, created by Don, is very simple tool, and it helps, when you start using Haskell, but this tool hasn’t any configuration and personalization of Haskell project, so I every time after creating project with mkcabal make some changes in the directory structure and file names.

ProjectTemplate is the template-based project creation tool. It was developed for ease creation of Haskell projects, but now I see, it could ease creation different directory structures, based on templates (for example web sites).

Templates are directories with files it them, which will be copied to the newly created project. Each template could contain complex directory hierarchy. Each file/directory name could be the plain name, or template name. Template name is created from the double underscore and parameter name, and in the project directory is substituted to the parameter value.

For example __ProjectName.cabal file with ProjectName parameter set to test, will be substituted to test.cabal. The same is true for directories.

ProjectTemplate also fills template files, where substitutes parameters to their values. The template file should have .template extension, which will be cut of in the destination file. In the template file parameters are enclosed in $ character. The example cabal file, with template parameters could look like:

name:                $ProjectName$
version:             0.1
synopsis:            
description:         
category:            $Category$
license:             BSD3
license-file:        LICENSE
author:              $Author$
maintainer:          $Maintainer$
build-depends:       base
build-type:          Simple

executable:          $ProjectName$
main-is:             src/Main.hs
ghc-options:

ProjectTemplate defines following parameters: ProjectName, Day, Month, Year. All other parameters will be asked to user during the project creation.

You could look at sample templates in the ProjectTemplate repository, to better understanding how this tool works.

Using PageRank to calculate HackageRank

2010-02-01T09:48:00.000-08:00

Previous article was introductory to the PageRank algorithm. Today I want to show one of the practical use of previous library.

Objectives

Hackage grows every day. Because of its centralized structure and the cabal tool, it is easy to install packages with all dependencies with single command.

But I always wonder, what packages are most important, and obviously present at almost all PC’s with Haskell. Sometimes looks strange, when simple library with several functions depends on more than 5 packages. Even when I have installed most popular packages, because my Haskell environment haven’t changed last year. Also I always have troubles with choosing the right library for Web server, or for work with database.

So I decided to apply PageRank algorithm to the Hackage. PageRank shows the probability of the random surfer to visit single page. Similarly HackageRank must show the probability for single package to be present on the random PC of the random haskeller.

The code

> module Main where
> 
> -- use distribution package to read dependencies
> import Distribution.PackageDescription
> import Distribution.PackageDescription.Parse
> import Distribution.PackageDescription.Configuration
> import Distribution.Verbosity
> import Distribution.Version
> import Distribution.Package
> 
> -- file utils, to enumerate directories
> import System.Directory
> import System.FilePath
> import System.Posix.Files
> 
> import System.Environment
> 
> import Control.Monad
> import Control.Applicative
> import Control.Arrow
> 
> import qualified Data.ByteString.Char8 as B
> 
> import qualified Data.Map as M
> import Data.Map (size, keys, fromListWith, toList)
> 
> import qualified Data.Set as S
> import Data.Set (empty, union, fromList, toList)
> 
> import Data.Maybe
> import Data.List (sortBy)
> 
> import Text.Printf
> 
> import Rank

Gathering all cabal files

All packages descriptions could be downloaded from the Hackage.

The path to the unpacked archive will be send through command line argument.

> isDir = liftA isDirectory . getFileStatus
> notDir = liftA not . isDir
> 
> directoryListing p = (map (p </>) . filterUpperDirs) <$> 
>                      getDirectoryContents p
>                        where 
>                          filterUpperDirs = filter (`notElem` [".", ".."])
> 
> cabalFiles root = do
>   dir <- directoryListing root
>   directories <- filterM isDir dir
>   files <- filterM notDir dir
>   subfiles <- concat <$> mapM cabalFiles directories
>   return (files ++ subfiles)

Read package names and dependencies

I pack all strings into byte strings, to reduce memory usage (the PageRank algorithm itself heavily uses memory).

> packName pkg = let (PackageName pkgName) = packageName pkg
>                in B.pack pkgName
> 
> dependencyName (Dependency (PackageName name) _) = B.pack name
> 
> packageDependencies pkg = 
>   let directDeps = buildDepends pkg
>       allBuildInfoDeps = 
>         concatMap (uncurry (++) . (buildTools &&& pkgconfigDepends))
>         (allBuildInfo pkg)
>   in map dependencyName (directDeps ++ allBuildInfoDeps)
> 
> parsePackageFile cabal = do
>   pkg <- flattenPackageDescription <$> readPackageDescription silent cabal
>   let deps = packageDependencies pkg
>   return ((packName pkg, S.fromList deps) : [(x, S.empty) | x <- deps])
>

Generate the list of all packages and their dependencies

enumeratePackages simply maps each package name to integer value. Previous versions of PageRank algorithm run out of memory, when I tried to use strings in vertex names.

> -- we have a list of elements in the form of: [(name, deps set)]
> -- the name could be repeated in the list, so let's convert it to
> -- map, and combine all sets
> packages root = do
>   largeList <- concat <$> (mapM parsePackageFile =<< cabalFiles root)
>   return (M.fromListWith (S.union) (filter (not . B.null . fst) largeList))
> 
> nameToIdx pkgsMap = M.fromList (zip (M.keys pkgsMap) ([0..]::[Int]))
> idxToName pkgsMap = M.fromList (zip ([0..]::[Int]) (M.keys pkgsMap))
> 
> enumeratePackages pkgsMap = 
>   let indexes = nameToIdx pkgsMap
>       getIndex name = fromJust (name `M.lookup` indexes)
>       enumerator (n, d) = (getIndex n, map getIndex d)
>   in map enumerator (M.toList (M.map S.toList pkgsMap))

Decode indexes to package names

Last function just simply decodes the integer values to the corresponding packages names.

> decodePackages pkgsMap ranks = 
>   let names = idxToName pkgsMap
>       getName idx = fromJust (idx `M.lookup` names)
>   in map (\(i, r) -> (getName i, r)) ranks
>

Main function

> main :: IO ()
> main = do
>   -- take the packages directory and number of iterations
>   (dir:iters:_) <- getArgs
>   -- read packages to the map
>   packagesMap <- packages dir
>   let hackageRankList = pageRankList 0.85
>                         (fromGraph (enumeratePackages packagesMap))
>       lastRank = decodePackages packagesMap 
>                  (fromRankGraph (hackageRankList !! (read iters)))
>       sortedRank = sortBy (\(_, r1) (_, r2) -> compare r2 r1) lastRank
>   -- printing rank to the screen
>   let formatString (n, r) = printf "%10.5f - %s\n" r (B.unpack n)
>   mapM_ formatString sortedRank

Some results

Here the Top20 of packages, by HackageRank:

 470.84702 - base
  90.73473 - syb
  68.48688 - ghc-prim
  57.82218 - integer
  57.56195 - integer-gmp
  57.55739 - rts
  57.52356 - integer-simple
  45.63995 - array
  34.83558 - mtl
  34.49726 - bytestring
  33.62577 - containers
  20.91788 - directory
  17.19401 - haskell98
  16.18344 - old-time
  14.68120 - filepath
  14.65891 - old-locale
  13.04511 - unix
  13.03026 - parsec
  11.40593 - random
  10.29807 - process

Hm. Doesn’t tell anything :) Let’s try to rank packages, which provides interface to sqlite database:

   0.41222 - HDBC-sqlite3
   0.33478 - hsql-sqlite
   0.33478 - hsql-sqlite3
   0.33024 - bindings-sqlite3
   0.31262 - sqlite
   0.29853 - haskelldb-hdbc-sqlite3
   0.29853 - haskelldb-hsql-sqlite
   0.29853 - haskelldb-hsql-sqlite3
   0.29853 - hsSqlite3

Much better, now I know, that best tool to work with sqlite is HDBC.

I think, there could be another uses of these calculations, waiting for your ideas.

The complete list of HackageRank calculated for Jan 31, 2010 you can download here.

Using Haskell to calculate PageRank

2010-01-31T08:49:00.000-08:00

PageRank algorithm was originally developed by the Google’s founders for ranking pages by their links. But the idea of ranking, based on references to the items could be used not only in Web, but in other different fields, which have directed graph structure. This article, and simultaneously Literate Haskell code, shows how to calculate page rank with Haskell.

PageRank algorithm

PageRank algorithm uses random surfer model. It calculates the probability of visiting concrete page by some surfer, who randomly clicks on different links on the page.

Originally PageRank for page A is the:

PR(A)=PR(P₁)/LC(P₁)+PR(P₂)/LC(P₂)+...+PR(P_n)/LC(P_n)

where LC(P_i) — is number of outgoing links from P_i, and P_i is all pages, which links to the A.

When page hasn’t outgoing links, that we suppose, that it connects to every other page in the Web.

Also PageRank includes damping factor — a probability, that random surfer will continue clicking links on each step. Usually damping factor equals to 0.85.

The previous PageRank formula with damping factor D will look:

PR(A)=(1-D)+D(PR(P₁)/LC(P₁)+PR(P₂)/LC(P₂)+...+PR(P_n)/LC(P_n))

Because, the link graph have cycles (i.e. PR(A) could indirectly depend on PR(A)), than calculating on page rank is iterative — on each step we recalculate whole graph, getting it closer to real PageRank value.

Thus the algorithm should look like:

Initialize PR(A_i) for all A_i with arbitrary value, simply 1
Calculate PR(A_i) for all A_i
Repeat step 2 specified times, or until the error will be relatively small

Implementation

> module Main where
> 
> import System.Random
> import Control.Monad
> import Control.Applicative
> import Data.Maybe
> import System.Environment
> 
> import qualified Data.IntMap as M
> import qualified Data.IntSet as S

Convert input data to more convenient structure

Our initial input data will have the form:

[(vertex, [vertexes to which current vertex links])]

vertexes, are integers, for more efficient implementation.

> -- Each vertex has its rank, number of outbound links and 
> -- set of inbound links
> data VertexProps = VertexProps {
>   vertexRank :: Double,
>   numOutboundLinks :: Int,
>   inboundLinks :: S.IntSet
>   } deriving Show
> 
> isDangling (VertexProps _ 0 _) = True
> isDangling _ = False
> 
> -- Our graph is map between vertex index and it properties
> type RankGraph = M.IntMap VertexProps
> 
> fromGraph :: [(Int, [Int])] -> RankGraph
> fromGraph gr = 
>   let depPairs (v, l) = (v, VertexProps 1 (length l) S.empty) :
>                         [(x, VertexProps 0 0 (S.singleton v)) | 
>                          x <- l]
>       depList = concatMap depPairs gr
>       catVertexes (VertexProps r1 l1 s1) (VertexProps r2 l2 s2) =
>         VertexProps (r1+r2) (l1+l2) (s1 `S.union` s2)
>   in M.fromListWith catVertexes depList
>

Implement single-step PageRank algorithm

> pageRank :: Double -> RankGraph -> RankGraph
> pageRank df gr = M.mapWithKey transformRank gr
>   where transformRank v (VertexProps r l s) = 
>           VertexProps (calcRank s) l s
>         -- calculate rank for a single vertex
>         calcRank s = (1 - df) + df * (danglingScore + (S.fold incomR 0 s))
>         -- sum of all linkVotes for vertixe vrt
>         incomR vrt r = r + (linkVote vrt)
>         linkVote v = let lvf (VertexProps r l _) = r / (fromIntegral l)
>                      in maybe 0 lvf (v `M.lookup` gr)
>         -- calculate the dangling score
>         -- sum all dangling page ranks and divide them to graph size
>         danglingPages = filter (isDangling . snd) (M.toList gr)
>         danglingScore = (sum (map (vertexRank . snd) danglingPages)) / 
>                         (fromIntegral (M.size gr))
> 
> pageRankList df gr = iterate (pageRank df) gr
> 
> -- Convert from RankGraph to list [(id, rank)]
> fromRankGraph = map (\(v, r) -> (v, vertexRank r)) . M.toList

Testing

Let’s test our creation. I create simple main program, that will read graph size from the command-line and calculate rank with 20 iterations. To force evaluation, we’ll just print last element from the result of the last iteration. Here I only interested in algorithm’s efficiency.

Generate test graph

> createTestGraph :: Int -> Int -> IO [(Int, [Int])]
> createTestGraph numPages maxLinks =
>   sequence [(,) p <$> outboundLinks p | p <- [1..numPages]]
>   where
>     outboundLinks p = do
>       outLinksNum <- randomRIO (0, maxLinks)
>       sequence [randomRangeNot p (1, numPages) | 
>         x <- replicate outLinksNum 0]
>       
>     randomRangeNot p (a, b) = do
>       v <- randomRIO (a, b - 1)
>       return (if v == p then b else v)

> main :: IO ()
> main = do
>   (gSize:gLinks:_) <- getArgs
>   rank <- pageRankList 0.85 . fromGraph <$> 
>           createTestGraph (read gSize) (read gLinks)
>   putStrLn ("Graph size: " ++ gSize ++ "x" ++ gLinks)
>   putStrLn ("20th iteration result: " ++ 
>             (show (M.toList (rank !! 20) !! ((read gSize) - 1))))

My algorithm works 7 seconds to calculate 20 iterations of PageRank for a graph with 10000 vertexes. Not bad, but I will be glad to reduce the memory usage because 150MB is too big for the tiny set of data.

Asus WL500g Premium controller now on Windows

2009-10-28T14:24:00.000-07:00

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

hs-ffmpeg now works from the box

2009-10-27T06:21:00.000-07:00

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.

Working with databases in Haskell. Part 2

2009-10-22T15:13:00.000-07:00

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"

2009-10-22T08:56:00.000-07:00

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.

Control your ASUS WL500g Premium from the command line

2009-10-15T11:33:00.000-07:00

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

2009-10-15T06:55:00.000-07:00

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:

hs-ffmpeg on Hackage
ffmpeg-tutorials on Hackage
hs-ffmpeg darcs repository on PatchTag
ffmpeg-tutorials darcs repository on PatchTag
project bug-tracker on Google Code

Multilingual UI and dynamic language selection with hgettext

2009-04-13T14:42:00.000-07:00

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:

possibility to switch between languages during the program execution
ability to work with different translations simultaneously in the single proses (i.e. in different parts of code or different threads)
should be some kind of notification to the rest program, that language is changed, to allow it redraw all visible elements on the screen
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:

Are there possibility to avoid liftIO calling so many times ?
How to make code which updates language string more clear and readable ? Are there some method to avoid IORef during creation internationalized message boxes ?

Configure and install internationalized Haskell application

2009-04-03T09:39:00.000-07:00

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.

hgettext on Hackage

2009-03-28T06:11:00.000-07:00

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.

I18n and Haskell

2009-03-27T08:00:00.001-07:00

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

2009-03-27T06:38:00.000-07:00

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 :)

Programs and programming

The Toilet Paper Entrepreneur. Not a review

Installing gtk2hs 0.12 for the latest Haskell Platform on the Windows 7

This is not all.

Other errors I've faced with, and the solutions

Error in compiling pango package, the compiler couldn't find glib/glib.h file.

Error in compiling gio package, some names aren't defined (wmDriveStopButton, DriveStartStopType, DriveStartFlags)

Released new version of ProjectTemplate. Now on Windows.

On creating Haskell projects. Cabal init.

ProjectTemplate - a template-based tool for creating Haskell projects

Using PageRank to calculate HackageRank

Objectives

The code

Gathering all cabal files

Read package names and dependencies

Generate the list of all packages and their dependencies

Decode indexes to package names

Main function

Some results

Using Haskell to calculate PageRank

PageRank algorithm

Implementation

Convert input data to more convenient structure

Implement single-step PageRank algorithm

Testing

Generate test graph

Asus WL500g Premium controller now on Windows

hs-ffmpeg now works from the box

hs-ffmpeg status.

ffmpeg-tutorials status

To do

Working with databases in Haskell. Part 2

Task description

Begin to code

Creating databases

Low-level access to the databases

High-level functions to work with data

Conclusion

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

Combining transactions with monad transformers

Control your ASUS WL500g Premium from the command line

Conclusion

Video processing on Haskell - easy

Several notes on building the sources.

Building hs-ffmpeg

Patching the SDL

Running ffmpeg-tutorials

Future work

Credentials:

Multilingual UI and dynamic language selection with hgettext

Configure and install internationalized Haskell application

Directory structure

Create install script

Update the program code

That's all?

hgettext on Hackage

I18n and Haskell

Less code - more functionality

Error in compiling `pango` package, the compiler couldn't find `glib/glib.h` file.

Error in compiling `gio` package, some names aren't defined (`wmDriveStopButton`, `DriveStartStopType`, `DriveStartFlags`)