Queen placement problem from HTDP exercise 28.2

queens.hs

-- 28.2 - Queen problem from HTDP
-- I took a few liberties here, thought constraint propagation might be faster
-- 'placement (buildBoard x) y' where x is the width/height of the chessboard in cells
-- and y is the number of queens to be placed, returns the first solution if that many
-- queens can be placed without cross-threatening, or Nothing if there is no solution

-- a Board consists of a list of positions of free tiles, and a list of positions of placed queens
type Posn = (Int, Int)
type Queens = [Posn]
type FreeTiles = [Posn]
data Board = Board FreeTiles Queens | Depleted deriving (Show)

buildBoard :: Int -> Board
buildBoard n = Board [(x,y) | x <- [1..n], y <- [1..n]] []

threatened :: Posn -> Posn -> Bool
threatened (x,y) (x',y') = x == x' || y == y' || x + y == x' + y' || max x y - min x y == max x' y' - min x' y'

constrainBoard :: Board -> Posn -> Board
constrainBoard (Board freeTiles queens) from = 
    let freeTiles' = [pos | pos <- freeTiles, not (threatened from pos)]
    in case freeTiles' of
            [] -> Depleted
            x  -> Board freeTiles' (from : queens)

placement :: Board -> Int -> Maybe Board
placement board 0 = Just board
placement (Board [] _) _ = Nothing
placement board@(Board (f:fs) queens) queensToPlace = 
    case constrainBoard board f of
         Depleted -> placement (Board fs queens) queensToPlace
         board' -> placement board' (queensToPlace - 1)