Monday, 25 January 2010

Dung Beetle Development

Dung-beetle style development - The feeling you get working on a code base where each change feels like pushing an ever bigger ball of crap.

A phrase I remembered from working with Roly that made me laugh!

Wednesday, 13 January 2010

Brian's Brain in Haskell and JavaScript

Last time I implemented the front-end for Brian's brain, which was simply a little canvas tag which stores the state of the grid.

This time it's the calculation side of things. First off we define some data types.

  data Cell = Off 
| On
| Dying
deriving (Eq,Show)

type GameGrid = Array (Int,Int) Cell

type Neighbours = [Cell]

data Game = Game GameGrid Int deriving Show

The grid is a two-dimensional array consisting of a cell. type is just used to give friendly names to types so I don't forget what they are!

Once we've defined these types we need a way of marshalling the data back and forth between Haskell and JavaScript. I couldn't find a better way to do this, so I've done it daftly. For cellToChar I'm sure there must be a way of encoding this information so that I don't have to explictly write out each case? I realise I could define Cell as type data Cell = State Char, but that still doesn't feel write as it's only for three specific instances of Char. Anyway!

  cellToChar :: Cell -> Char
cellToChar Off = '0'
cellToChar On = '1'
cellToChar Dying = '2'

charToCell :: Char -> Cell
charToCell '0' = Off
charToCell '1' = On
charToCell '2' = Dying
charToCell _ = error "Undefined character received"

This now means we can write the main server code as shown below.

  createGame :: Int -> [Cell] -> Game
createGame x c = Game (listArray ((0,0),(x-1,x-1)) c) x

gridToString :: Game -> String
gridToString (Game g _) = map cellToChar (elems g)

processMessage :: String -> String
processMessage s = map cellToChar newGrid where
[cellSizeStr,original] = lines s
cells = map charToCell original
cellSize = read cellSizeStr :: Int
newGrid = step (createGame cellSize cells)

listenLoop :: Handle -> IO ()
listenLoop h = do
msg <- readFrame h
sendFrame h (processMessage msg)
listenLoop h

main :: IO ()
main = serverListen 9876 listenLoop

The rules for Brian's Brain are simple and are easily expressed in Haskell.

  rules :: Cell -> Neighbours -> Cell
rules On _ = Dying
rules Off cells | length (filter (/= Off) cells) == 2 = On
| otherwise = Off
rules Dying _ = Off

List comprehensions make the code very concise.. I've avoided special cases at the edges of the grid for neighbours by assuming it wraps around.

  neighbours :: Game -> (Int,Int) -> Neighbours
neighbours (Game c s) (x,y) = [c ! ((x+dx) `mod` s, (y+dy) `mod` s)
| dx <- [-1,0,1], dy <- [-1,0,1], dx /= dy]

step :: Game -> [Cell]
step g@(Game c s) = [ rules (c ! p) (neighbours g p) | p <- coords] where
coords = [(x,y) | x <- [0..(s-1)], y <- [0..(s-1)]]

Using the Canvas2Image script I was able to create an animation in all of 5 minutes that shows how this looks (create the images, script to save them all, shove them in APNG Edit).

Unfortunately it looks like APNG isn't very well supported so I had to create a video instead. Using ffmpeg you can create a video like this (assuming your files are named 001.jpg, 002.jpg and so on).

ffmpeg -r 3 -b 1800 -i %03d.jpg output.mp4

3 is the framerate and 1800 is the biterate. See here for more information.


And so ends the fun experiment of writing a UI in HTML for a backend in Haskell!

Tuesday, 12 January 2010

Brian's Brain in JavaScript and Haskell

Brian's Brain is a celluar automaton, similar to the Game of Life, but where each cell can be in one of three states (on/off/dying). As an adventure in the absurd, I created a Brian's Brain simulation using JavaScript for the front end and Haskell for the back end. With web sockets being so simple to use, it seems like if I want to design a UI I may as well just use the web. Plus it seems like a good way to learn two technologies at the same time!

The canvas element gives you a rendering surface that you can access with JavaScript. There's many good tutorials on using the canvas element, I read Creating a Breakout Clone to understand what was going on.

Hopefully (assuming that I've put the script in correctly below), you should see a grid below. Clicking and dragging the mouse across the grid changes the state.

Your browser does not support canvas, but imagine something awesome here instead!

The JavaScript code to do this is available here. The idea is that when the user clicks a button on the JavaScript side, we'll package the grid up as a string, send it across to Haskell, get the data transformed, and send it back again. The first line sent from JavaScript contains the size of the grid; it's assumed to be square because that was easiest! The next line contains a complete dump of all the data in the grid.

if ('WebSocket' in window) {
ws = new WebSocket('ws://localhost:9876/');
ws.onopen = function() {
$('#connectionStatus').text('Connection opened');
ws.onclose = function() {
$('#connectionStatus').text('Connection closed');
ws.onmessage = function(evt) {
return true;

$('#step').bind('click', function() { runStep(ws); });

function runStep(ws) {
var cells = '';
var pos = 0;
for (i=0;i<cellCount;++i) {
for (j=0;j<cellCount;++j) {
cells += grid[i][j];
ws.send(cellCount + '\n' + cells);

The first step on the Haskell side is to make something reusable from the code I had last time for the web element. This means exposing it as a module and separating out the logic for handling requests from server them. The complete code is here but the main changes are to make acceptLoop function accept an additional argument which handles communication back and forth.

module Web (serverListen, sendFrame, readFrame) where

acceptLoop :: Socket -> (Handle -> IO ()) -> IO a
acceptLoop socket f = forever $ do
(h,_,_) <- accept socket
hPutStr h serverHandshake
hSetBuffering h NoBuffering
forkIO (f h)

With this code we can now write a new web sockets server just by writing a small function to handle the sending and receviing of messages.

listenLoop :: Handle -> IO ()
listenLoop h = do
msg <- readFrame h
sendFrame h msg
listenLoop h

main :: IO ()
main = serverListen 9876 listenLoop

In the next post, I'll look at the game logic in Haskell.

Tuesday, 5 January 2010

Bidirectional Web Sockets

Thanks to some very helpful comments on the last post and some example code I was able to see what I was doing wrong with bidirectional communication.

I'd tried to use hGetContents and just read off one message at a time. This is doomed to failure because laziness and hanging around on a network socket that's in a semi-closed state just isn't going to work.

In this version of the code we enter a loop which terminates once the client sends the "quit" message (rather than an infinite loop).

(Update: Thanks to helpful comments edited the code to use Control.Monad.when)

listenLoop :: Handle -> IO ()
listenLoop h = do
sendFrame h "hi, remember you can stop this at anytime by pressing quit!"
msg <- readFrame h
putStrLn msg
when (msg /= "quit") (listenLoop h)

readFrame :: Handle -> IO String
readFrame h = readUntil h ""
readUntil h str = do
new <- hGetChar h
if (new == chr 0)
then readUntil h ""
else if new == chr 255
then return str
else readUntil h (str ++ [new])

On a side note - the indentation for the if/then/else is a little strange, but "if within do" at least explains why.

All that remains is a quick bit of HTML to allow you to have a conversation. Replace the body in the previous example with something like this (and also make sure that the ws object has the appropriate scope!

<h1>I'm doing something</h1>

<div id="output">

<div id="connectionStatus">

<textarea rows="2" cols="80" id="message">
Type whatever you want here, but type quit to close the connection

<br />

<button id="clickMe" onClick="ws.send($('#message').val());">
Click me!

You should get something where you can have a rather boring conversation with Haskell. It repeats the same text over and over again until you press quit.

Monday, 4 January 2010

Web Sockets and Haskell

Web Sockets are a new technology which allows continuous bi-directional communication between the browser and the server. It's not supported by many browsers at the moment, but recently Google announced support for it in Chrome.

The API isn't very difficult to understand, as there's only three callback functions! At the client level you simply create a socket connection with callbacks for open connection, close connection and message received. As a consumer of web sockets that's all you need to know.

The server side is a little more complicated (but not much). There's a new protocol (web socket protocol). To explore this, I built a quick Haskell application to send data from Haskell to the browser. I haven't quite got how to send data back again (DOM Exception 11 is just *so* helpful for debugging).

Before your web sockets code will do anything, it must be hosted on a server and not served from the file system. To configure Apache to do this on Ubuntu, you'll need to edit /etc/apache2/sites-available/default and make it point to the appropriate place (or copy it and create your own configuration). Apache can be restarted with apache2ctl restart.

I used the Network package and a simple main function which accepts a connection, spawns a new thread to handle it and repeats the process.

The most complicated part of the code was getting the server handshake correct. The below is hardcoded for communication on localhost with port 9876. Get the handshake wrong and you'll get all sorts of baffling errors. I found that tcpdump was invaluable in troubleshooting these kinds of errors as I was able to capture the packets and compare them to a web sockets example in Erlang.

import Network
import System.IO
import Control.Concurrent
import Char

serverHandshake =
"HTTP/1.1 101 Web Socket Protocol Handshake\r\n\
\Upgrade: WebSocket\r\n\
\Connection: Upgrade\r\n\
\WebSocket-Origin: http://localhost\r\n\
\WebSocket-Location: ws://localhost:9876/\r\n\
\WebSocket-Protocol: sample\r\n\r\n"

acceptLoop socket = forever $ do
(h,_,_) <- accept socket
hPutStr h serverHandshake
hSetBuffering h NoBuffering
forkIO (listenLoop h)
forever a = do a; forever a

main = withSocketsDo $ do
socket <- listenOn (PortNumber 9876)
acceptLoop socket
sClose socket
return ()

listenLoop :: Handle -> IO ()
listenLoop h = do
sendFrame h "hello from haskell"
threadDelay (3 * 1000000)
sendFrame h "it works!"
return ()

sendFrame :: Handle -> String -> IO ()
sendFrame h s = do
hPutChar h (chr 0)
hPutStr h s
hPutChar h (chr 255)

forkIO makes handling the socket on a separate thread trivial, it spawns off a new lightweight thread (lightweight in the sense of being very cheap to create) to handle the IO processing.

The browser side isn't too bad either. I used Google's CDN to pull in JQuery and just hooked up some handlers to append various bits and pieces as events occurred.

<title>Web Sockets</title>

<script src=""></script>

$(document).ready(function() {

if ("WebSocket" in window) {
var ws = new WebSocket("ws://localhost:9876/");
ws.onopen = function() {
$('#connectionStatus').text('Connection opened');
ws.onmessage = function(evt) {
$('#output').append('<p>' +;
ws.onclose = function() {
$('#connectionStatus').text('Connection closed');
else {
$('#connectionStatus').append('<p>Your browser does not support web sockets</p>');

<h1>I'm doing something</h1>

<div id="output">

<div id="connectionStatus">


I guess the next task is to do something exciting with web sockets!

(Update: After the extremely helpful comments I was able to get Bidirectional Web Sockets working

(Update 2: Realized that the server hand shake should not have a trailing \0 so remove it in the code example).