Calculate solutions to the 8 queens on a 5x5 board problem

Queens.hs

{-# LANGUAGE TupleSections #-}

import Control.Arrow (first, second)
import Control.Monad (forM_)
import Data.List (intersperse, intersect, (\\))
import System.IO (hFlush, stdout)

-- Generate the list of possible choices of n items from a list
-- Each choice is a pair of the chosen and not-chosen items
choices 0 xs  = [([], xs)]
choices _ [] = []
choices n (x:xs) = map (first (x:)) (choices (n-1) xs) ++ map (second (x:)) (choices n xs)

-- The list of positions that can be taken by a queen at position (r, c)
sightings (r, c) =
    [ (y, c) | y <- [0..4], y /= r ] ++
    [ (r, x) | x <- [0..4], x /= c ] ++
    [ (y, x) | y <- [0..4], y /= r, let x = c-r+y, 0 <= x && x <= 4 ] ++
    [ (y, x) | y <- [0..4], y /= r, let x = c+r-y, 0 <= x && x <= 4 ]

-- Remove positions that are visible from a white position
prune (ws, rest) = (ws, foldl (\\) rest $ map sightings ws)

-- Arrange blacks in whatever remains
blacken = second (map fst . choices 5)

-- Change a first with a list of seconds into a list of first and seconds
flatten (x, ys) = map (x,) ys

-- Lists of positions and arrangements
everywhere = [(r, c) | r <- [0..4], c <- [0..4]]
whitings = choices 3 everywhere
solutions = concatMap (flatten . blacken . prune) whitings

-- Put the given arrangement of pieces on a board
arrange (whites, blacks) = [[color (r, c) | c <- [0..4]] | r <- [0..4]]
  where color p
          | p `elem` whites = 'W'
          | p `elem` blacks = 'B'
          | otherwise = '-'

-- Render a board as a multi-line string
showBoard = unlines . map (intersperse ' ')

-- Output all the solutions
main = forM_ solutions $ \s -> do
        putStrLn . showBoard . arrange $ s
        hFlush stdout