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.

The problems that you can solve this way have some interesting properties: you must never send any private data to the clients and typically the solution should be expensive to find, but easy to verify.

I’m curious what kind of cool appliciations we can build using this technology. If a major site like Facebook would include a tiny bit of javascript that takes 5 seconds of your processor time to help fight AIDS, it would probably be a tremendous help.

I would be very interested in your thoughts on this matter. Are there more problems that we could solve this way? I’m mainly interested in the technical implications, but there are lots of non-technical issues as well. For example: would you need the client’s permission to do this?

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 ‘toy’ I’ve written today however is pretty useful. It lets you attach files to an email from the console. Instead of having to reach for the mouse and navigate to the folder you’re already in, you can just do mailfile checkthis.tar.gz. If you already started on an email the file will be attached to the draft, else it will open up a new compose window and you’re good to go!

#!/usr/bin/osascript
 
on run argv
  if argv is {} then
    return "Pass at least one filename as an argument!"
  end if
 
  set pwd to system attribute "PWD"
 
  tell application "Mail"
    try
      set composeMessage to first outgoing messages where visible is equal to true
    on error
      set composeMessage to make new outgoing message at beginning with properties {visible:true}
    end try
 
    tell composeMessage
      repeat with fileName in argv
        if not fileName starts with "/" then
          set fileName to pwd & "/" & fileName
        end if
        tell content
          make new attachment with properties {file name: fileName} at after the last paragraph
        end tell
      end repeat
    end tell
 
    activate
 
  end tell
end run

Place this code for in /usr/local/bin/mailfile (or some other ‘bin’ dir that’s in your path), and make it executable. You can also download it from github.

I think the code is pretty readable. You might notice that attachments are just added to the content of the email, there is no concept of attachments outside of the content. You might also notice how I totally inappropriately abuse the exception catching mechanism for something I could have tested before. In my defense I’d like to say this is just a simple script and it uses less code this way ;)

Something that took me a while to figure out was how to get the current working directory, which I needed because else it could only handle full paths. Turns out the script needs a bit of help from the environment variables or ’system attributes’ as they are called in AppleScript.

My first try was to find the directory the script itself is in, which is not the way to go when you want to put it somewhere central. But because there is a lot of bad/old information on how to do that online, I’d still like to share the following code snippet

  tell application "System Events"
    set pwd to POSIX path of container of (path to me)
  end tell

Note that I’m using “System Events” here and not the Finder.

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