Between running around, listening to interesting presentations and talking to cool people we were able to code up a module enabling us to use Happstack through FastCGI. This scratches an itch we’ve had for some time: we’re running a couple of HAppS/Happstack servers on our server but they’re configured to work through mod_proxy, which means having to choose an unique port for each application and doing (re)starting the servers by hand.

We just released happstack-fastcgi on Hackage. This post gives an example of how to use it with Apache and mod_fastcgi.  We assume you configured the extension ‘.fcgi’ for FastCGI scripts.

Converting your Happstack code

Let’s look at a ‘normal’ Happstack application. Usually, it has a main function that looks something like this…

import Happstack.Server
 
main = simpleHTTP nullConf server
 
...

Where the “server” part is something of the type ServerPart a. To make this work with FastCGI, we need to convert the server parts so that they talk FastCGI.

import Happstack.Server
import Happstack.Server.FastCGI
 
simpleCGI :: (ToMessage a) => ServerPartT IO a -> IO ()
simpleCGI = runFastCGIConcurrent 10 . serverPartToCGI
 
main = simpleCGI server
 
...

Assuming the above code is placed in a script called Main.hs, you can compile it with

ghc -threaded --make Main.hs -o main.fcgi

Notice the ‘-threaded’, because else we won’t be able to serve request concurrently (other than having FastCGI start an extra instance of our program, which we don’t want when we’re working with happstack-state, for example).

So, let’s fill something in for server, for example

server = withRequest $ return . show

This will simple dump the request as it has been translated from a CGI request to a Happstack request.

Running it with Apache

Just for reference, the FastCGI documentation is your friend, but he might be a bit long-winded, so I will do a short recap of the basic things.

Let’s first do the easy thing. If you set up FastCGI correctly and made it the handler for .fcgi scripts, you can just throw the .fcgi file (like we just compiled) anywhere within your document root (provided that the ExecCGI option is enabled for that directory) and go to the correct URL with your browser.

Using scripts in this way is called ‘dynamic’ in FastCGI-speak. With a bit more configuration (unfortunately on server/virtual host config level) we can run the script ‘statically’, which means it will be started when Apache is started and (by default) gets one process. This is particularly important when using happstack-state, things might very well go wrong otherwise. To set up a ‘static’ FastCGI script, you must use FastCGI’s FastCgiServer configuration directive.

Make sure you restart Apache when you change the script (or use FastCGI’s autoreload setting, which introduces a bit of overhead but is much more convenient).

Nice URLs and serving static files

Now you have the FastCGI file running, you might want to do something about the URLs, because doing requests to http://example.com/main.fcgi/some/url doesn’t really look that nice. As an added advantage, you can now use Apache to serve your static files, reducing the work your Happstack server needs to do.

The traditional .htaccess trickery looks something like this:

Options ExecCGI
DirectoryIndex main.fcgi

RewriteEngine on
RewriteCond %{REQUEST_FILENAME} !-f
RewriteCond %{REQUEST_FILENAME} !-d
RewriteRule (.*) main.fcgi/$1 [PT,L]

(If your application is running in a subdirectory, you also need the RewriteBase configuration directive.)

Closing words

We did some really simple benchmarks that show that using Happstack through FastCGI, either dynamic or static, is about as fast as using Happstack directly or even mod_proxy (which is pretty fast, but a hassle).  That means the overhead is (as expected) quite small.

At first, we wanted to demo it with Gitit, but unfortunately Gitit or some library that uses Gitit tries to get the PATH environment variable and gives an error when it doesn’t succeed… So, if your Happstack application doesn’t (seem to) work with FastCGI, keep an eye on your logs.

Patches and bugreports are very welcome. You can clone the repository from Github, enjoy.

Even for skilled developers, if a project grows big enough it becomes a lot harder to understand and maintain. Changes in one part may influence a seemingly unrelated part in the software. For example, in a language like Javascript, if you add a parameter to a method, it’s easy to forget to update one or two other functions that call it, but you’ll find out at runtime. Hopefully. Or else your customer will find it out for you.

It would be great if software developers could say with confidence that they have working software. Most of the bright Ruby developers I know strongly advocate test-driven development, not only to verify their programs but also to help them design the program. Programmers in a strongly typed language like Haskell often do the same thing: they’ll first write down the type, which forces them to really think about the function. The type of a function states what the input is, and in a pure language, you even have to state the kind of side-effects that can occur.

Both unit testing and strongly typed programming forces you to build your software in such a way that it is easily testable. They encourage you to write small functions that perform one specific task. Your program will almost automatically be broken down into small bits. I hardly find myself writing functions that are longer than a couple of lines, which also helps me to understand the functions even if I haven’t looked at them in a while.

In both unit testing and purely function programming you have to be explicit about state. What needs to be set up before you can call a function? Will there be side-effects? What should the state be like afterward?

Over time, programs will also evolve, and at some point, you’ll have to do refactoring. If you have correctly specified your unit tests, you can easily change a method and the tests will show you where it breaks. In Haskell, I very often change a method’s type signature and implementation, knowing that the compiler will tell me what I broke.

To summarize: unit testing and strongly typed (pure) programming overlap a lot. With unit testing you can specify a lot of things that you can’t always easily do in your type system. Most notably, you can inspect the results of functions, which is something that you can not do in, for example, Haskell. There are other type systems that do allow you to do this, but that’s beyond the scope of this article. On the other hand, when working in Haskell, you’ll get the types for free most of the time. Instead of starting with a type, you can also start with the implementation and let the type-checker infer the type for you.

Both test-driven development and type-driven development can help you to make your code more understandable and better designed. I believe that, although there are a lot of differences, both approaches will help you build programs that are more safe and easier to understand. I guess all the unit-testing rubyists and purely functional Haskellers are not so different after all.

We’re going to build a small paddle game, where you can control the paddle with your keyboard. The first thing we’re going to build is the paddle. This is straightforward, if the user presses a key, we’ll move sideways, depending on the key that’s pressed. First, listening to a key press:

  ElementA(document).next(EventA('keypress'))
                    .next(movePaddle)
                    .next(Repeat).repeat()
                    .run();

You should read the first two lines of the code like this: if the ‘keypress’ event happens on the document, we’re going to move the paddle. This is very different from regular javascript events, because there you attach an event and do the movePaddle every time there is a keypress. However, using arrowlets, the event is only caught once. Therefore we also need to have the next line that says: do this forever. The last line actually starts the code.

The body of the movePaddle function is only two lines:

function movePaddle(event) {
  var offset = (event.keyCode == 37) ? -4 : (event.keyCode == 39 ? 4 : 0);
  paddle.style.left = Math.max(0, Math.min(paddleLeft() + offset, 230)) + "px";
}

When the user presses a button “Start” that will start the game. Before we actually start animating, we’ll have to reset the field and place the ball. The ElementA function will find an element in the DOM, and the next resetGameOver updates the status.

  ElementA('start').next(EventA('click'))
                   .next(ElementA('gameOver')).next(resetGameOver)

The function resetGameOver code looks like this:

var resetGameOver = function(el) { el.innerHTML = ''; }

Next, we’ll reset the position of the ball and tell it to start moving every 30ms:

                   .next(ElementA('ball'))
                   .next(resetBall)
                   .next(moveBall.animate(30))

The code for resetBall simply resets the position and direction of the ball:

var resetBall = function(ball) {
  dir = {x: 4, y: -4}
  startPos = (100 + Math.random() * 40) + "px";
  ball.style.left = startPos; ball.style.top = "120px";
  return ball;
}

Note that it returns the ball, so the next function can make use of it:

var moveBall = function(ball) {
  var newLeft = parseInt(ball.style.left) + dir.x;
  var newTop  = parseInt(ball.style.top)  + dir.y;
  if(newLeft <= 0 || newLeft >= 260) dir.x = 0 - dir.x;
  if(newTop  <= 0) dir.y = 0 - dir.y;
  ball.style.left = newLeft + "px";
  ball.style.top = newTop + "px";
  if(newTop > 240) {
    if(newLeft > paddleLeft() -5 && newLeft < paddleLeft() + 45)
    { 
      dir.y = 0 - dir.y;
      return Repeat(ball); 
    } else return Done  (ball);
  }
  else return Repeat(ball);
}

The first two lines calculate a new left and top. If the ball bounces against one of the side walls, we invert the x-direction. Similarly for the top. If, however, we reach the bottom of the screen, things a bit more complicated: if the ball hits the paddle, we invert the y-direction and return Repeat(ball). The Repeat means that we’re not finished with our animation. If the ball misses the paddle, we return Done(ball). This means our animation is finished an the user’s game is over.

Now we can go on with the next part of our game handling code:

                   .next(ElementA('gameOver')).next(gameOver)
                   .next(Repeat).repeat()

We show the gameOver status message, and then repeat this infinitely, so the user can start a new game. And that’s it, that’s all the code. Here’s a link to the game, and also a link to the source code..

Disclaimer: The code only works in Firefox and Opera. In Safari there’s no keypress event for the arrow keys, and the arrowlets library currently doesn’t support IE.

 module Main where
 import HAppS.Server
 import Control.Applicative
 import Control.Applicative.Error
 import Control.Applicative.State
 import Text.Formlets
 import Text.XHtml.Strict ((+++), (<<), (!))
 import qualified Text.XHtml.Strict as X
 import qualified Data.Map as M

First of all, we are going to build a form that accepts a date (consisting of two parts: a month and a day). Our datatype reflects this:

 data Date = Date {month :: Integer, day :: Integer} deriving Show

We want to prevent the user from entering weird dates, so

 validDate :: Date -> Bool
 validDate (Date m d) = m `elem` [1..12] && d `elem` [1..31]

Now we are going to write a FailingForm that reads two integers, and uses them to create a real Date. Using applicative style, we can nicely express this:

 dateComponent :: FailingForm Date
 dateComponent = Date <$> inputIntegerF (Just 1) <*> inputIntegerF (Just 16)

We can now combine dateComponent and validDate to create a validating Date component:

 dateFull :: FailingForm Date
 dateFull   = dateComponent `check` ensure validDate "This is not a valid date"

Finally, if we use some helper functions we can create a ServerPart, which is everything HAppS needs in order to run:

 handleDate :: [ServerPart Response]
 handleDate = withForm "date" dateFull showErrorsInline (\d -> okHtml $ show d)

This will show a form, and if you press “Submit”, it will make sure all validations pass, and show you the value. If the form doesn’t get validated, it will show a list of errors, and you can change your previously entered values.

To demonstrate the compositionality of formlets, we will create a User datatype, and use the date-formlet to let the user enter a birthDate:

 data User = User {name :: String, password :: String, birthdate :: Date} deriving Show
 
 userFull :: FailingForm User
 userFull = User <$> inputF Nothing <*> passwordF Nothing <*> dateFull

And that’s all there is to it! We now have user form that asks for a name, a password and a birthdate. We can use the withForm function again to handle the GET and POST:

 handleUser = withForm "user" userFull showErrorsInline (\u -> okHtml $ show u)

Finally, here are all the helper functions we used:

 withForm :: String -> FailingForm a -> (X.Html -> [String] -> Web Response) -> (a -> Web Response) -> [ServerPart Response]
 withForm name frm handleErrors handleOk = 
   [dir name 
      [ method GET           $ okHtml $ createForm [] frm
      , withDataFn lookPairs $ \d -> [method POST $ handleOk' d]
      ]
   ]
   where ((extractor, html), endState) = runFormState [] frm 0
         handleOk' d = case extractor d of
                         Failure faults -> handleErrors (createForm d frm) faults
                         Success s      -> handleOk s
 
 showErrorsInline :: X.Html -> [String] -> Web Response
 showErrorsInline renderedForm errors =
   okHtml $ X.toHtml (show errors) +++ renderedForm
 
 createForm :: Env -> FailingForm a -> X.Html
 createForm env frm =
   X.form ! [X.method "POST"] << (xml +++ X.submit "submit" "Submit")
    where ((extractor, xml), endState) = runFormState env frm 0
 
 okHtml :: (X.HTML a) => a -> Web Response
 okHtml content = ok $ toResponse $ htmlPage $ content
 
 htmlPage :: (X.HTML a) => a -> X.Html
 htmlPage content = (X.header  <<  (X.thetitle << "Testing forms")) +++ (X.body    <<  content)
 
 main = simpleHTTP (nullConf {port = 5000}) (handleDate ++ handleUser)

For the full code, see Main.lhs. Make sure you have installed HAppS-Server and formlets from hackage. Enjoy!

Update: There is now a wiki page on Formlets which we try to keep up to date with examples that compile with the latest version. The example above only works with an old version of formlets.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

import NLP.Stemmer
import Control.Monad (unless)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
 
main :: IO ()
main = do
    putStrLn "Enter a sentence to stem, an empty line to stop."
    hSetBuffering stdout NoBuffering -- to print a prompt
    stemUserInput
 
stemUserInput :: IO ()
stemUserInput = do
    putStr "> "
    string <- getLine
    unless (string == "") $ do 
        putStrLn $ (++) "< " $ unwords $ 
                               stemWords English $ 
                               words string
        stemUserInput

You see? Much nicer, no more C-like pointer adminstration cruft that you wouldn’t expect in Haskell, just a simple (pure) function ‘stemWords’ (line 17) which, given an algorithm, stems a list of strings. (I suppose a next version of the library should have an implementation for bytestrings as well.)

As the attentive reader might have noticed, the example above is not semantically equal to the previous one, since there is no sign the stemmer is constructed only once and deleted at the very end. To explain the implementation of the library, I’d like to show how you can still use the more C-like interface, minus the tedious pointer administration.

Let me introduce withStemmer, inspired by withHMatrix.

withStemmer :: Algorithm -> (Stemmer -> IO a) -> IO a
withStemmer algorithm action = do
    stemmer <- new algorithm
    result  <- action stemmer
    delete stemmer
    return result

Using withStemmer I can now repeat the example above, but with the semantics of the example of the previous post. (For a quick scan: only line 1, 9, 16 and 17 changed.)

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

import NLP.Stemmer.C
import Control.Monad (unless)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
 
main :: IO ()
main = do
    putStrLn "Enter a sentence to stem, an empty line to stop."
    hSetBuffering stdout NoBuffering -- to print a prompt
    withStemmer English stemUserInput
 
stemUserInput :: Stemmer -> IO ()
stemUserInput stemmer = do
    putStr "> "
    string <- getLine
    unless (string == "") $ do
        string' <- mapM (stem stemmer) $ words string
        putStrLn $ (++) "< " $ unwords string'
        stemUserInput stemmer

Notice that I’m using NLP.Stemmer.C (line 1) and that the stemming now must be done inside the IO monad (line 16). In practice this is probably a mere inconvenience, but a pure Haskell interface is of course much nicer… Introducing to the stage unsafePerformIO (organ sounds: dum, dum, duuum).

I’ve defined a nice ‘unsafe’ version of withStemmer as a helper:

{-# NOINLINE withStemmer #-}
withStemmer :: Algorithm -> (C.Stemmer -> IO a) -> a
withStemmer algorithm action = unsafePerformIO $ 
    C.withStemmer algorithm action

And now I can easily define two very nice functions

stem :: Algorithm -> String -> String
stem algorithm input = 
    withStemmer algorithm (\stemmer -> C.stem stemmer input)
 
stemWords :: Algorithm -> [String] -> [String]
stemWords algorithm input = 
    withStemmer algorithm (\stemmer -> mapM (C.stem stemmer) input)

stemWords is there for efficiency reasons, since I suppose stemming a list of words is a common action. It’s much nicer (and a bit faster) to ‘keep the stemmer alive’ and use a mapM internally, than letting the user do map stem ....

So, unsafePerformIO, eh? It took me a couple of tries to get to this interface, but I think it turned out pretty okay. Word of advice, make sure that you read the tips and docs carefully. Also, don’t mix multiple unsafePerformIO calls, that was at least a sure recipe for segfaults in my case ;)

Fortunately for us, there are already good libraries and tools out there to help us. So instead of trying to write everything from scratch, we made a small library based on Snowball’s libstemmer_c and a very (very!) rough start of a Sphinx client (more about that in a later post).

We’ve released the library on Hackage so check out stemmer 0.1

A small code example to give you a taste…

module Main where
 
import qualified NLP.Stemmer as Stemming
import Control.Monad (unless)
import System.IO (hSetBuffering, stdout, BufferMode(NoBuffering))
 
main :: IO ()
main = do
    stemmer <- Stemming.new Stemming.English
    putStrLn "Enter a sentence to stem, an empty line to stop."
    hSetBuffering stdout NoBuffering -- to print a prompt
    stemUserInput stemmer
    Stemming.delete stemmer
 
stemUserInput :: Stemming.Stemmer -> IO ()
stemUserInput stemmer = do
    putStr "> "
    string <- getLine
    unless (string == "") $ do 
        string' <- mapM (Stemming.stem stemmer) $ words string
        putStrLn $ "< " ++ unwords string'
        stemUserInput stemmer

Save this to Main.hs and then do something like

$ ghc --make Main.hs -o stemmer
[1 of 1] Compiling Main ( Main.hs, Main.o )
Linking stemmer ...
$ ./stemmer
Enter a sentence to stem, an empty line to stop.
> The fishes worked forever with their fins
< The fish work forev with their fin
> Stemming with Haskell
< Stem with Haskel


It was pretty easy to implement this library and also a nice exercise in using Haskell's Foreign Function Interface.

The code is relatively straightforward: fetch the top artists for a given username, parse that csv-file, read the events in The Netherlands for every artist, and output every event. It works on the command line. Save this code as Upcoming.hs, then do runhaskell Upcoming.hs chrisflip, and replace chrisflip by your own last.fm username.

Enjoy!

module Main where
 
import Network.Curl
import Text.CSV
import Network.CGI (urlEncode)
import Text.XML.Light
import Data.Maybe (fromMaybe, fromJust)
import Control.Monad
import System.Environment (getArgs)
 
-- The top artists of last.fm
url u = "http://ws.audioscrobbler.com/1.0/user/" ++ u ++ "/topartists.txt"
 
-- Upcomings's country_id for The Netherlands 
country_id = "9"
upcoming_url artist =  "http://upcoming.yahooapis.com/services/rest/?api_key=" 
                    ++ apikey ++ "&method=event.search&search_text=" 
                    ++ urlEncode artist ++ "&country_id=" ++ country_id
apikey = "ee395ae6dd"
 
main = do
  [username] <- getArgs
  text <- unsafeCurlGetString (url username)
  let (Right a') = parseCSV (url username) text
      artists = getArtists a'
  mapM_ getEvents artists
 
-- The artist is always in the 3rd column of the csv-file
getArtists = map (!! 2) . filter (\x -> length x == 3)
 
getEvents artist = unsafeCurlGetString (upcoming_url artist) >>= processArtist artist
 
processArtist artist contents = do
  let eventEls = elChildren $ fromJust $ parseXMLDoc contents
  when (length eventEls > 0) $ do
    putStrLn artist
    putStrLn (replicate (length artist) '-')
    mapM_ processEvent eventEls
    putStrLn ""
 
processEvent evt = putStrLn $ title ++ " @ " ++ location ++ " [" ++ date ++ "]"
 where [title, location, date] = map fa ["name", "venue_name", "start_date"]
       fa n = fromJust $ findAttr (unqual n) evt
 
unsafeCurlGetString url = curlGetString url [] >>= return . snd