Custom Search

Friday, April 17, 2015

Functional Mazes

Long time, no blog!

Wow, it's been a long time since I posted here. Well, I've been involved with rc stuff and 3d printing things.

The latter is what led to this post. I ran into a 3d printed maze that was generated programmatically. The authors comment that trying to do this in OpenSCAD was impossible because it was a functional language.

I had to disagree. First, that OpenSCAD is a functional language. It might have functional inspiration, and the developers try to stay with those principles, but as a functional language, it sucks. So much so that I wrote a Haskell library to generate OpenSCAD from a proper functional language, with static type checking and much better error messages.

Second, I disagree that a maze generator is impossible in a functional language. There was a time in the past - long enough ago that I was working in BASIC, C and PostScript - that I wrote maze generators. So I decided to write one in Haskell. The generator is purely functional, though the State monad is used to hide some of the plumbing.

The algorithm

The algorithm I use is a bog-standard recursive walk of the cells in the maze. We start with walls between all the cells, and pick a random cell. Then take each of it's four neighbors in random order. If a neighbor has been visited, we skip it. Otherwise, remove the wall between those two cells, and recursively walk from that neighbor as well.

You can find this algorithm described on rosettacode. This will include implementations in a number of languages, including a more idiomatic Haskell version.


A maze is just an array of cells that either have halls or walls between each cell. Each cell needs two walls, one for each direction, and boolean to note that it's been visited. Which gives us the basic data types for a maze:

data Wall = Wall | Hall deriving Eq
data Cell = Cell { x, y :: Wall, visited :: Bool }
type Board = Array (Int, Int) Cell

If you're wondering why only two walls and not four, it's because each wall is shared by two cells. So each cell will have the wall with the larger coordinate in each direction. In particular, the x wall is the wall that runs in the y direction with the largest x coordinate, and vice versa.


To work with the array, we need a few tools from Data.Array:

import Data.Array (Array, array, bounds, (//), (!))

We need the Array type for our type declarations, which we've already seen. The array function is used to create the initial array. bounds gets the bounds of the array so we don't have to pass those around. // is used to create a new array with a list of changes to an array, and ! is used to reference a Cell in the array.

Generating the board

So our initial maze needs to have every cell with both walls, and initially not visited. That's just a Cell wall wall false.

But our maze is going to have a border around it, for a number of reasons. We can make the walk easier by creating border cells as visited. So the walk won't need to do bounds checking. And the border on the low coordinate sides will have the wall on that side, and no others. That will simplify drawing the maze. And as a final touch, we'll put entry and exit doors in the maze at the diagonally opposite corners on the axis.

So we have a function makeCell that looks convoluted, but each part is straightforward. For a Board of width w and height h, we make the cell at i, j with:

makeCell i j = Cell (if j == 0 then Hall else Wall)
                    (if i == 0 || i == 1 && j == h || i == w && j == 0
                     then Hall else Wall)
               $ i == 0 || i > w || j == 0 || j > h

This creates a Cell with an x Wall except for the first element in the j direction, and a y Wall except for the first element in the i direction, as otherwise we'd try and draw those. We also create Hall's for 1, h and w, 0, which will be the entry and exit for the maze.

Finally, if either x or y is 0 or x is greater than w or y greater than h, then mark these border Cell's as Visited, so we won't visit them during the walk. All other cells haven't been visited yet.

So now we can create the array with array and makeCell:

makeBoard w h = array ((0, 0), (w+1, h+1))
                      [((i, j), makeCell i j) | i <- [0..w+1], j <- [0..h+1]]

array takes list of pairs of indices and values and converts it to an array whose bounds are given as the first argument. In this case, bounds are (0, 0) and (w+1, h+1). That makes the border the indices that have 0 for either x or y, and w+1 for x and h+1 for y. A list comprehension generates the indices, and we call makeCell on them to create the Cell for each index.

The walk

We start with helper functions to remove each wall from a cell. Well, since this is a functional language, we can't actually remove the wall, so instead well have functions that return a cell with the appropriate wall removed. And one to return a visited cell.

clearY, clearX, visit :: Cell -> Cell
clearY cell = cell {y = Hall}
clearX cell = cell {x = Hall}
visit cell = cell {visited = True}

A step is represented by a tuple indicating the motion in the x and ydirections, so we'll want a list of all possible steps, allSteps:

 allSteps = [(0, 1), (0, -1), (1, 0), (-1, 0)]

The body of the walkMaze function is straightforward. Just pick a random cell in the maze, then call the internal helper walkCell for allSteps, that board position and our original Board:

i <- state $ randomR (1, (fst . snd $ bounds origBoard) - 1)
j <- state $ randomR (1, (snd . snd $ bounds origBoard) - 1)
walkCell (i, j) allSteps origBoard

walkCell implements the "in every direction from each cell" part of the algorithm by calling itself recursively, removing a random move from the list of moves it was passed on each recursion, stopping when there are no more moves. It uses doStep to walk the Board after that step:

walkCell _ [] b = return b
walkCell start steps board = do
  step <- (steps !!) <$> (state . randomR) (0, length steps - 1)
  walkCell start (delete step steps)
    =<< doStep start step (board // [(start, visit $ board ! start)])

doStep just calls walkCell on allSteps and the cell it steps to, after removing the wall between the Cell it's stepping from and the new Celll. The last bit is the hard part, requiring examining the move in detail:

doStep from@(i, j) (dX, dY) board
  | visited neighbor = return board
  | dY > 0 = walkCell' $ board // [(from, clearY cell)]
  | dY < 0 = walkCell' $ board // [(new, clearY neighbor)]
  | dX > 0 = walkCell' $ board // [(from, clearX cell)]
  | dX < 0 = walkCell' $ board // [(new, clearX neighbor)]
  where cell = board ! from
        new = (i + dX, j + dY)
        neighbor = board ! new
        walkCell' = walkCell new allSteps 

So we can put all that together to get:

walkMaze :: Board -> State StdGen Board
walkMaze origBoard = let
  clearY cell = cell {y = Hall}
  clearX cell = cell {x = Hall}
  visit cell = cell {visited = True}

  allSteps = [(0, 1), (0, -1), (1, 0), (-1, 0)]

  walkCell _ [] b = return b
  walkCell start steps board = do
    step <- (steps !!) <$> (state . randomR) (0, length steps - 1)
    walkCell start (delete step steps)
      =<< doStep start step (board // [(start, visit $ board ! start)])

  doStep from@(i, j) (dX, dY) board
    | visited neighbor = return board
    | dY > 0 = walkCell' $ board // [(from, clearY cell)]
    | dY < 0 = walkCell' $ board // [(new, clearY neighbor)]
    | dX > 0 = walkCell' $ board // [(from, clearX cell)]
    | dX < 0 = walkCell' $ board // [(new, clearX neighbor)]
    where cell = board ! from
          new = (i + dX, j + dY)
          neighbor = board ! new
          walkCell' = walkCell new allSteps 
  in do
    i <- state $ randomR (1, (fst . snd $ bounds origBoard) - 1)
    j <- state $ randomR (1, (snd . snd $ bounds origBoard) - 1)
    walkCell (i, j) allSteps origBoard

The key to doing this in a functional language is generating a new Board for the various recursive calls, rather than mutating a Board and just using recursion to keep track of the progress of the walk.

This is liable to create a lot of extra state in each recursion. I haven't made any attempts to minimize that, which you would want to do in a solution for production use. Idiomatic Haskell would use the State monad for the Board to hide the extra plumbing, as is done with the random number generator.

Displaying the board

While the walk above is the meat of this blog entry, I find the display code interesting, so will cover that as well.

It would be nice to be able to plug in various different types of output to display the maze, so that we can debug with ASCII to a terminal or a Diagram before adding code to generate OpenSCAD code. So we'll use a Board drawing function that takes functions that generate the walls and pastes them together. The type for the function is:

drawBoard :: (Board -> Int -> Int -> a)    -- make X-direction cell walls
             -> (Board -> Int -> Int -> a) -- make Y-direction cell walls
             -> ([a] -> b)                 -- combine [walls] into a row
             -> ([b] -> IO ())             -- Draw the board from [rows]
             -> Board                      -- Board to draw
             -> IO ()

As you can see, it takes two functions that create Wall's, one in each direction. Then a function to combine a list of walls into a row, and finally one that takes a list of rows and outputs the final maze. For a larger program, it might be worthwhile to use a Render data type to hold those for functions, but for a simple demo, it's just extra formula.

The wall drawing functions get the Board and indices, as the indices may be needed to calculate where the wall needs to go. However, we are also going to generate the rows by generating the walls for the Cell's in order of increasing x, then do the same to put the rows together in order of increasing y.

So the actual drawBoard code is:

drawBoard makeX makeY makeRow makeMaze board =
  makeMaze . concat $ [firstWall]:[drawCells j | j <- [1 .. height]]
  where height = (snd . snd $ bounds board) - 1
        width = (fst . snd $ bounds board) - 1
        firstWall = makeRow [makeX board i 0 | i <- [0 .. width]]
        drawCells j = [makeRow [makeY  board i j | i <- [0 .. width]],
                       makeRow [makeX board i j | i <- [0 .. width]]]

This builds firstWall, which is the x direction walls for the 0'th y row. We don't bother making the y direction walls for that row, since they aren't part of the maze proper. That firstWall is wrapped in a list and consed onto the list output by drawCells, which outputs a list consisting of a row x walls and a row of the y walls for the Cell's in that y direction. We draw the 0 Cells in each row to generate the y direction Wall that forms the boundary of the maze. There are no x direction Walls in those Cells, but either makeRow or DrawX will be responsible for dealing with any other artifacts that these cells might generate.

That result is passed to concat to turn it into a list of rows instead of a list of lists of rows, which are passed to makeMaze to output the maze.

Drawing in ASCII

For ASCII output, we only need two extra functions:

charX, charY :: Board -> Int -> Int -> String
charX board i j = if y (board ! (i, j)) == Wall then "---+" else "   +"
charY board i j = if x (board ! (i, j)) == Wall then "   |" else "    "

An x Wall is a horizontal line of dashes, and a y wall is a vertical bar. Hall's are just blank spaces, except for a + at an intersection. Note that an x Wall is the y element of a Cell, as the Cell element is named for the direction you are facing, but the Wall rendering is named for the direction the wall runs.

makeRow is simply drop 3 . concat, to paste the strings together and then remove the extra Hall's drawCells creates for the 0 cells in each row. makeMaze is just putStr. unlines.

At this point, if you load the module (available via the fossil repository link on the right) into ghci, you can print square grids. Just use :main 16 8 to print a 16 by 8 maze. Or on a Unix system, you should be able to do ./maze.hs 16 8 to generate a maze from the shell.

Graphical output

That works, but it's not very pretty. So let's do a little graphics. Since I'm not much of a graphics designer, it still won't be very pretty.

Support routines

This is a bit more complicated, so let's start with a couple of support routines.

diaSpace is used to create a spacer. It takes an R2, which is a direction, and a Double indicating how long it is. It outputs a Diagram B R2, which is something we can draw. Given that it's a spacer, it won't draw anything when drawn.

diaSpace :: R2 -> Double -> Diagram B R2
diaSpace unit size = phantom (fromOffsets [unit # scale size] :: Diagram B R2)

diaCell does all the work. It needs to know which Wall to check in a Cell, which direction to draw in, any spacer needed, and the cell size. Plus the board and the cell's index:

diaCell :: (Cell -> Wall) -> R2 -> Diagram B R2 -> Double -> Board -> Int -> Int
           -> Diagram B R2
diaCell side unit space cellSize board i j =
  space ||| make (side (board ! (i, j)))
  where make Wall = strokeT (fromOffsets [unit # scale cellSize])
        make Hall = diaSpace unit cellSize

diaCell returns the space in front of the result of calling the internal function make on the Cells' Wall. make is simple - it uses diaSpace to return a blank space for a Hall, and the Diagram primitives to create a line of length cellSize in the given direction.

Drawing cells.

Given diaCell, the two routines for drawing walls are simple:

diaX, diaY :: Double -> Board -> Int -> Int -> Diagram B R2
diaX = diaCell y unitX mempty
diaY cellSize = diaCell x unitY (diaSpace unitX cellSize) cellSize

The type of diaX and diaY match the types needed by drawBoard. diaX is just diaCell with the y Wall selector as it's first argument, the x direction and an empty spacer, as the wall spans the entire length of the Cell. diaY needs the cellSize argument as well, since the spacer it passes to diaCell is a cellSize spacer created by diaSpace.

Drawing the board

The row creator for drawBoard is simply the Diagram function hcat, which accepts a list of diagrams and puts them together horizontally in a new diagram.

The board creator is almost that simply, but is actually long enough to get it's own function:

diaBoard :: Double -> [Diagram B R2] -> IO ()
diaBoard ww rows =
  renderCairo "maze.png" Absolute $ vcat rows # centerXY # pad 1.1 # lwO ww

As with the row creator, the bulk of the work is done by the Diagram function vcat, which stacks the diagrams up vertically instead of horizontally. That image is then centered by centerXY, padded by pad 1.1, and the line weight is set to the wall width with lw0 ww. That diagram is passed to renderCairo along with some extra arguments so that it creates an appropriately scaled output in the file maze.png.

Seeing the result

The version of maze.hs in the fossil repository has the Diagram (and OpenSCAD) drawing code commented out. Once you install the diagrams package and the diagrams-cairo package, you can change that. Look for three places where a line starts with {- Comment out. The first two will need to be moved down to the next blank line. The last one will need to be moved down to beneath diaBoard. You can now run this in ghci as :main 16 8 40 2, or as ./maze.hs 16 8 40 2. The two new arguments are the size of the cell and the width of the walls to draw. The old ASCII invocations will still work as well.

After running it with 4 arguments, the file maze.png will be created in the current directory, and you can display that.

Expanding this to display images from the command line, or to embed it in an app for solving mazes, is left as an exercise for the reader. In which case, it ought to be made pretty as well.

Printing in 3d

The inspiration was a 3d-printed maze, so let's do that. This is very similar to the Diagrams code, so the commentary will be a bit shorter.

To show what using an encapsulating data type would look like, this uses the SCADCell data type, consisting of the side selector, a routine to construct the appropriate wall, and a Vector3d to move the wall to the appropriate place in the cell:

data SCADCell = SCADCell (Cell->Wall)                           -- Wall extractor
                         (Double -> Double -> Double -> Model3d) -- Wall drawing
                         Vector3d                                -- translation

This is the first argument to scadCell. scadCell just creates a the appropriate wall and base, or a 0-sized block if this is a border Cell. It also need the cell size, wall dimensions and base depth to create those models. scadX and scadY just call scadCell with the appropriate SCADCell.

scadX, scadY :: Double -> Double -> Double -> Double -> Board -> Int -> Int
                -> Model3d
scadX cs = scadCell (SCADCell y (flip box) (0, cs, 0)) cs
scadY cs = scadCell (SCADCell x box (cs, 0, 0)) cs

scadCell :: SCADCell -> Double -> Double -> Double -> Double ->
            Board -> Int -> Int -> Model3d
scadCell (SCADCell side box' move) cs ww wh bd board i j =
  make (side $ board ! (i, j))
  # translate (cs * fromIntegral (i - 1), cs * fromIntegral (j - 1), 0)
  where make Wall = box' ww (cs + ww) (bd + wh) # translate move <> base
        make Hall = base
        base = if i == 0 || j == 0 then box 0 0 0
               else box (cs + ww) (cs + ww) bd

Again, there's a function in the library that does exactly what we want for turning the output of the cell drawing routines into a row. So we just use union for this. That same function also serves to join the rows into a board, so we just need to compose it with draw in order to print the maze. However, this prints the maze "upside down" compared to the previous two rendering engines, so we use mirror to fix that as well. No real need, but it feels like the right thing.

You'll need to install version or later of my Haskell OpenSCAD library from hackage and uncomment the appropriate code segments to use it. You can then run it as either :main or ./main.hs, using arguments like 16 8 20 2 4 10. That's the same four arguments as the Diagram version, with the depth of the base and the height of the walls added.

To see the results, you'll also need the OpenSCAD application. That can generate an STL file, and getting it to a 3d printer from there is up to you.


Just for completeness, a brief look at the main routine that ties it together. This is really just a kludge to test the others, but it does the job.

The outline is to get the arguments, map them to integers. Sorry, no fractional sizes here. Then convert those to floats for the things that need them. Switch on the length of the argument list to either raise a usage error or create a drawBoard' function that's just the drawBoard invoked with the functions appropriate to the type of output we want.

Then get a random number generator, and run mazeWalk using it on a board of the appropriate size, which we will use the newly created drawBoard' to output.

main :: IO ()
main = do
  args <- map read <$> getArgs
  let floats = map fromIntegral args
      drawBoard' =
        case length args of
          2 -> drawBoard charX charY (drop 3 . concat) (putStr . unlines)

          4 -> drawBoard (diaX cs) (diaY cs) hcat (diaBoard ww)
               where [_, _, cs, ww] = floats

          6 -> drawBoard (scadX cs ww wh bd) (scadY cs ww wh bd) union
                         (draw . mirror (0, 1, 0) . union)
               where ([_, _, cs, ww, bd, wh]) = floats
{- Comment out drawing argument handling
          _ -> error "Width Height [CellSize WallWidth | CellSize WallWidth WallHeight BaseDepth]"
  gen <- newStdGen
  drawBoard' $ evalState (walkMaze $ makeBoard (head args) (args !! 1)) gen

Thursday, October 16, 2014

Extending the behavior of XMonad Layouts


This article is about three things I'm very interested in. I've been a fan of using real programming languages for configuration files for a long time, but haven't written about that recently. I've been using tiling window managers - now in their dynamic version - for a long time as well, and have written about that. Finally, I've been a fan of Haskell for a while, and have written a number of articles about using it.

XMonad is a dynamic, tiling window manager written in Haskell that uses a Haskell module as a configuration file. This has the usual advantages of doing so - you can put values in variables rather than repeating them, and construct new values with Haskell expressions, etc.

One of the features of XMonad is a Layout, which controls how windows are tiled on the screen. The core of XMonad provides some basic - but very useful - Layouts, and there are extensions to do things like creating tabbed stacks of windows, nesting Layouts, etc.

Since Layouts control how windows are arranged, they are critical components, and changing them is how you change your window managers behavior. I'm going to look at extending the behavior of one of the core Layouts - Tall - in a number of ways.

And a credit. The code here was inspired by Devin Mullins, who provided information and code samples while helping me with my XMonad configuration.


A Layout needs to be an instance of the LayoutClass type class. As such, aLayout needs to do three things: run the layout, handle Messages from the window manager, and optionally provide a description. You can find details on that in the API documentation.

Different description

description is "a human-readable string used for selecting Layout's." Some tools display them for selection, others use descriptions to select Layouts programmatically, say from a list of strings in the configuration. These different uses give rise to different needs, so we'll start by just changing it. This would allow us to have two different Tall layouts, and tell the difference between them.

First, we need to declare our data type:

data MyTall a = MyTall (Tall a) deriving (Show, Read)

Now we need to make this an instance of LayoutClass. Running will be forwarded to the wrapped Tall with the runLayout method. The same will be done with Messages by the pureMessage method. I'll get into the details of those later.

instance LayoutClass MyTall a where
  runLayout (W.Workspace id (MyTall tall) ms) r =
    fmap (second (fmap MyTall)) $ runLayout (W.Workspace id tall ms) r

  pureMessage (MyTall tall) m = fmap MyTall $ pureMessage tall m

And the critical part is to change the description:

  description _ = "MyTall"

So now we can create two different Tall Layouts with different names: one is a regular Tall layout, and the other a MyTall layout. Exactly how you do that will depend on your XMonad config file, but you would just add a Tall layout and wrap it in a MyTall like one of these examples:

MyTall (Tall *...*)
MyTall $ Tall *...*

Instead of just displaying the name, we could display information from the Layout. One of the features of Tall is a master pane, which holds a programmable number of client windows - typically the one or two you're working on now, with other windows dynamically sized in a second pane. The wrapped Tall has the format Tall n delta frac, where n is the number of clients in the master pane. We can put that count in the description like so:

  description (MyTall (Tall n _ _)) = "Tall " ++ show n

We can still have two Tall Layouts with different names, but now the second one is distinguished by having the number of client windows in the master pane displayed.

More Messages

Commands for a Layout are described by the Message type class. Tall has two messages, one to change the size of the master pane, and one to change the number of windows in it. I tend to use either one or two windows in the master pane, and would like the ability to toggle between those two states.

Toggling the master pane

So we'll create a new Message, ToggleMaster to toggle the number of clients in the master pane:

data ToggleMaster = ToggleMaster deriving Typeable
instance Message ToggleMaster

Now, we need to change the existing pureMessage method to handle this Message. Let's dissect the current version first:

pureMessage (MyTall tall) m = fmap MyTall $ pureMessage tall m

pureMessage gets a MyTall Layout and a SomeMessage, m. It returns a Maybe (layout a). Forwarding the message is easy - we just call pureMessage on the wrapped Tall, extracted by pattern matching in the function. The returned Maybe Tall needs to be rewrapped to a Maybe MyTall. fmap MyTall does that for us.

To handle the Message ourselves, we need to get the actual message from the SomeMessage, which fromMessage will do for us. If that returns Just ToggleMaster, then we want to handle this Message. Otherwise, it will return Nothing, and we pass the message as before. So far we have:

  pureMessage (MyTall tall) m =
    case fromMessage m of
      Nothing -> fmap MyTall $ pureMessage tall m
      Just ToggleMaster -> undefined

To handle the ToggleMaster message, we need to return a MyTall Tall where Tall has the new number of client windows we want in the master pane:

  pureMessage (MyTall tall@(Tall n delta frac)) m =
    case fromMessage m of
      Nothing -> fmap MyTall $ pureMessage tall m
      Just ToggleMaster -> Just . MyTall $ Tall new delta frac
        where new = if n /= 1 then 1 else 2

This uses pattern matching to get the values in the Tall. When we get a ToggleMaster Message, we create the new value if n /= 1 then 1 else 2 . While I usually toggle between 1 and 2 clients, it handles all other cases by going back to 1 as well. To finish this, we create a new Tall that we wrap with Just . MyTall.

Binding ToggleMaster

We can now bind that in our configuration with:

    , ((modm              , xK_slash), sendMessage ToggleMaster)

This uses Mod-slash to toggle the master window, which seems to work well with Mod-comma and Mod-period, the defaults for incrementing and decrementing the number of clients in the master pane.

Target Toggles

If you also used three client window regularly, you might want a separate toggle for that. We're going to do that in two different ways.

Extending ToggleMaster

First, we can simply give ToggleMaster an argument and a name change to match:

data ToggleMasterN = ToggleMasterN !Int deriving Typeable

And the changed bindings, including using backslash for the 3-way split:

    , ((modm              , xK_slash), sendMessage $ ToggleMasterN 2)

    -- Toggle the master window split 3-way.
    , ((modm              , xK_backslash), sendMessage $ ToggleMasterN 3)

And then we change the handling in pureMessage to use that argument instead of 2:

      Just (ToggleMasterN i) -> Just . MyTall $ Tall new delta frac
        where new = if n /= 1 then 1 else i

Splits as well.

But suppose we wanted a command that always split the master window, no matter what it currently was? Let's call it SetMasterN, and the code to handle it is pretty simple:

      Just (SetMasterN new) -> Just . MyTall $ Tall new delta frac

I'll omit the bindings. The new Message is similar to ToggleMasterN:

data SetMasterN = SetMasterN !Int deriving Typeable
instance Message SetMasterN

So all we have to do is get the code for SetMasterN to be run in pureMessage. We're going to refactor pureMessage a bit to do that:

  pureMessage (MyTall tall@(Tall n delta frac)) m =
    msum [fmap MyTall $ pureMessage tall m,
          fmap toggle  (fromMessage m),
          fmap set     (fromMessage m)]  
    where toggle ToggleMaster  = MyTall $ Tall new delta frac
                                 where new = if n /= 1 then 1 else 2
          set (SetMasterN new) = MyTall $ Tall new delta frac

Each element of the list passed to msum handles a different set of messages. The first line passes all of them to Tall, and it will return Nothing if it doesn't handle that message. Each element after that will pass the appropriate messages to the function that handles them, or be Nothing. msum then returns the Just value from the list.


As a final note, you can access the X monad values if you use handleMessage instead of pureMessage. This lets you access the XConf and XState values via ask and get.

It's type is

handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))

so requires another level of fmap calls to work with the values in the Layout. Details can be found in the API documentation.

Extending the Layout

The last set of functions in a LayoutClass are the ones that generate the rectangles that windows wind up in. At this point, you're really past extending the Layout, and are writing a new one. But I'm going to look at a simple case anyway.

The oddity of 0

One of the odder behaviors of the default Tall Layout is that putting all the windows in the master pane and putting none of the windows in the master pane gets the same layout. Both wind up with all windows stretching the width of the screen. It's just that in one, they're in the master pane, and in the other they're in the other pane.

The difference between them is that you can keep increasing the master pane count until you hit maxBound, but once you decrease it to 0, it won't go any lower. So you can use IncMasterN minBound to get to 0 from any value. Once you've got SetMasterN or ToggleMaster, you can use those instead, and use IncMasterN maxBound to get to the layout that was at 0. Which means 0 can be used for something else.

A full screen mode

Give the above, we can extend Tall so that putting 0 windows in the master pane makes the first window a full screen window. While I think that this makes as much sense as the current behavior, it makes life a bit difficult if the only message you have is IncMasterN.

The layout functions are passed a Rectangle, and a Stack of windows, and should return a list of tuples of (window, Rectangle). The simplest of the layout functions is pureLayout, which does just that. The value we want to return to get a full screen window is a list with a single tuple consisting of the first window and the initial rectangle:

import XMonad.StackSet as W

pureLayout _ r s = map (, r) . take 1 $ W.integrate s

The function W.integrate returns a list of the windows in the Stack. While this pureLayout should never be called with an empty list of windows - there's a method specifically for handling that - using map and take instead of [(head $ W.integrate s, r)] insures that we don't generate an exception should that happen. Instead, we return an empty list, which is the default behavior.

Forwarding the non-zero cases

We want the above code to run when the master pane client count is 0, and otherwise we'll let Tall handle it. That's done like so:

pureLayout (MyTall tall@(Tall n _ _)) r s =
  if n != 0 then pureLayout tall r s
  else map (, r) . take 1 $ W.integrate s

Forwarding simply unwraps the Tall Layout and passes that and the non-Layout arguments along to the Tall method.

And the rest

pureLayout is the simplest of the layout functions. If your layout function isn't quite so pure, you can use doLayout. doLayout returns a value in the X monad, so you can access the XState and XConf values. The value it returns is a tuple consisting of the list returned by pureLayout and a Maybe Layout of the same type that was passed in. The Maybe Layout allows the Layout to be modified, ala the Message handling examples.

While those two are normally sufficient, there's also emptyLayout and runLayout. Both of these return the same type as doLayout. The default implementation of runLayout calls emptyLayout if there are no windows and doLayout otherwise. You should only need these if you want special handling for the case where there are no windows. Details can be found in the API documentation.

Monday, May 12, 2014

Web apps that write like console apps

My history with the web

When the web first showed up, I was delighted. Here was a tool I could use to release cross-platform apps by releasing one app. Since I was working for a multi-platform software vendor, this was great - we had people with Macs, Windows machines, and most of the available Unix workstations. Now I could write an app once and they could all use it.
So I started automating some of the things we hadn't done before because we couldn't reach the entire audience or afford to alienate those we couldn't reach. Write an HTML page or two, the code to process the input, and then write out the results, and we're done. All fun, easy and productive.
Then something evil happened. Web templates. Suddenly, it wasn't about writing code any more. It was about writing templates, then writing code fragments to plug values into the holes. Worse yet, most template systems broke the better web text authoring tools, at least until those tools were taught about that template language. They had the same effect on web text processing tools. Writing for the web was no longer fun, easy or productive. So I stopped.
And every time I've looked at web application tools since, it seems there's been another level of complications added to paper over the problems with template systems. Routes. Adapters. Messy config files. A simple app might have more text in config files than in code. And this is seriously considered a good thing?

Application types

Console applications aren't necessarily easy to write. But the logic at least flows through them in a straightforward way. You evaluate expressions, and some of those trigger user interactions. With a web template, you're never sure when the fragments that plug things in will get evaluated. Unless, of course, the web template system makes guarantees about that. Most don't. This makes the code fragile. Again, not fun, easy or productive.
Of course, a typical graphical desktop application has many of the same problems. You provide a user interface, and then connect code fragments to it that interface elements cause to run. It's a bit more predictable than the web interface, because the fragments are controlled by UI elements instead of plugging into a template. But it's still more painful than a console application.


I recently ran into MFlow, and for the first time in a long time found myself wanting to write a web application. MFlow makes web applications write like console applications - you evaluate expressions that trigger user interactions. Except they happen in the browser, not a terminal window.
MFlow leverages Haskell's do syntax to make the web interactions happen at the right time. In particular, what's been called the "programmable semicolon" nature of that syntax.

Example application

To show how this works, I wanted to use a simple application, so I chose a very simple game. It's known by a number of names, but the rules are easy. You start with a pile of matches, and alternate turns taking either one or two matches. The player that takes the last match wins. Which means a game - its complete state - can be represented by a single integer.

Not production quality

Note that this code is not production quality code. I've left out any kind of error checking that would obscure the code, haven't done anything to make it pretty, and in general kept it as short and simple as possible. I have tried to keep it idiomatic, though.

The game

The code below extends the Game state to have Lost/Won/Illegal indicators, the latter used when someone makes an illegal move. The functions just update a game with a move, finds the computers next move, provide an English description of a move, and of course tie those together to handle everything that happens between the human player making a move and being prompted for their next move. All completely independent of any actual interface code.

module Game (Game (..), move, prompt) where

data Game = Illegal | Won | Lost | Game Int deriving (Show)
type Move = Int

-- Create a prompt for the current game and message.
prompt :: String -> Int -> String
prompt m l = m ++ "There are " ++ show l ++ " matches. How many do you take? "

-- Given a game and a move, provide a description for the move.
describeMove :: Game -> Move -> String
describeMove g m =
    case g of
        Won      -> "You won. "
        Lost     -> "I took " ++ show m ++ " and you lost. "
        Illegal  -> "You can only take 1 or 2 matches. Taking the last match wins the game. "
        (Game _) -> "I took " ++ show m ++ ". "

-- Given a game and a move, return the Game resulting from the Move.
makeMove :: Game -> Move -> Game
makeMove g@(Game l) m | m /= 1 && m /= 2 = Illegal
                      | m >= l           = Won
                      | otherwise        = Game $ l - m

-- Given a Game, find the best move for it
findMove :: Game -> Move
findMove (Game l) | l <= 2       = l
                  | rem l 3 /= 0 = rem l 3
                  | otherwise    = 1

-- Given a game and player move, calculate computer move and
-- return (message, new game)
move :: Game -> Move -> (Game, String)
move g m = case makeMove g m of
               Illegal -> (g, describeMove Illegal 1)
               Won     -> (Won, describeMove Won 1)
               Lost    -> (undefined, "Can't happen! ")
               g'      -> let m' = findMove g' in
                              case makeMove g' m' of
                                  Won  -> (Lost, describeMove Lost m')
                                  Lost -> (undefined, "Can't happen! ")
                                  g''  -> (g'', describeMove g'' m')

Console interface

This being a very simple game, the interface is also simple. Just loop printing how many matches are left in the game and then get a move from the user. The code is below, and runnable at the FP Complete School of Haskell:

module Main where

import Game

-- loop that actually plays the game.
play :: Game -> String -> IO String
play g@(Game l) m = do
    putStrLn $ prompt m l
    x <- fmap read getLine
    case move g x of
        g'@(Game _, _) -> uncurry play g'
        (_, m')        -> return m'

-- Main entry: play the game and announce the results
main :: IO ()
main = do
       m <- play (Game 8) "Hello. "
       putStrLn m

The play function has the obvious structure: we print (with putStrLn) the prompt for this move. Then read a line from the (with getLine) and use read to convert it to an integer. We run the move function from the Game module to get a message and new game after applying the user and computer moves. If that's still of the form Game n, then the game isn't over, so we loop and do it again. Otherwise, we return the message to main. main is likewise straightforward: run the play function with a greeting to get a string describing the results, then print the results.

Web interface

If you write web apps - especially if you do it in Haskell - you might consider writing up this web app in your favorite framework. If you do it in Haskell, feel free to use my Game module! I haven't done it, because I probably couldn't escape claims of biasing the results. And besides, I'm lazy. If you do this, please provide us with a link to or a copy of your code so others can look at it!
Ok, the web application uses the same basic structure. The code is below, and runnable in the FP Complete School of Haskell.

module Main where

import MFlow.Wai.Blaze.Html.All

import Game

-- loop that actually plays the game.
play :: Game -> String -> View Html IO String
play g@(Game l) m =
    (toHtml (prompt m l) ++> br ++> getInt Nothing <! [("autofocus", "1")])
    `wcallback` \x ->
        case move g x of
            g'@(Game _, _) -> uncurry play g'
            (_, m') -> return m'
-- Main entry: play the game and announce the results
main :: IO ()
main = runNavigation "" . step $ do
    m <- page $ play (Game 20) "Hello. "
    page $ toHtml m ++> wlink () << " Another game?"

The play function looks a lot like play in the console version. The code to output HTML is a bit more complicated, because - well, we've got to produce a lot more text.  Wrap the prompt in HTML, provide a br tag. Instead of using getLine and read to get an integer, we use getInt and apply an autofocus attribute to the resulting tag. As a the final bit of IO, we use wcallback to extrract the integer rather than just extracting it directly, as that will erase the previous contents of the page. On the other hand, the rest of the function - not involving any user interaction - is identical between the two versions.
main is similar. We need a short expression to deal with running on the Web instead of in a console before the do code. The play function result is passed to a page so it runs in a web page. Likewise, the message gets translated to HTML, and we tack on a link to start over before handing that to page to display.


While the actual display code is a bit more complicated - we are dealing with a remote display that needs things wrapped in markup - the basic structure is still the same. play prompts the user, reads the result, and then loops or exits. main just invokes play and then displays its result, though the Web version has a link to play again added to it.


While the code is pretty much idiomatic Haskell as is, I have made one change from what I'd write in order to enhance the similarity. The do in the console version desugars nicely, and I'd probably have used that version main = play (Game 5) "Hello. " >>= putStrLn if I weren't doing the comparison. The web version could be desugared, but would require an explicit lambda or an ugly transformation to point-free style, so I'd leave it as is.

Programmable semicolons?

I mentioned "programmable semicolons". That's one of the characterizations of the do syntax for Haskell. Yes, there are no semicolons in this code. Like most modern languages, Haskell makes them optional at the end of a line.
For the console code, semicolons behave pretty much as you'd expect them to. For the web code, there's a pleasant surprise in store for you. You probably tried entering an illegal move - something not 1 or 2 - at some point, and noticed that you were told the rules of the game, and then prompted again. Both versions behave the same way, and that behavior is explicit in the code.
Did you try entering values that weren't valid integers? Say a hello? If not, do so in both now. The console version exits with an obtuse error message. I did tell you that the code wasn't production quality. The web version tells you the value isn't valid, and prompts you again. Part of that is getInt - it will fail to validate if the value you input doesn't read as an Int type. The other is the "programmable semicolon" behavior: if some expression fails, that step of the display gets run again instead of propagating the failure.


I think this short demonstration illustrates nicely that MFlow allows for writing web applications with the same architecture as console applications, where that is appropriate. While setting up the display takes more work, I don't believe that can be fixed with anything that uses HTML for the display description.
On the other hand, dealing with user input is easier than a console, because all you get from a console is a string of text, whereas the MFlow framework can process it to a known type, and handles invalid input for you. In fact, if you just use getTextBox in a context where the inferred type is an instance of Read, it will work for any type. Some care must be taken if the inferred type is Maybe a, though, which getInt (and friends) avoids.
The bottom line is that it tends to balance out, and writing web apps is once again, easy, fun and productive.