Latin squares

LatinSquare.hs

import Data.Monoid
import Data.Set (Set, (\\))
import qualified Data.Set as Set

type Square a = [Row a]
type Row a = [a]

main :: IO ()
main = mapM_ (putStrLn . unlines) (genSquare (Set.fromList "abc")) where

genSquare :: Ord a
          => Set a  -- ^ the alphabet
          -> [Square a]
genSquare alphabet = go (Set.size alphabet) (repeat Set.empty) where
  go n above
    | n > 0 = do
        (row, nextAbove) <- unzip <$> genRow alphabet above
        (row:) <$> go (n-1) nextAbove
    | otherwise = pure []

genRow :: Ord a
       => Set a        -- ^ the alphabet
       -> Row (Set a)  -- ^ reserved so far upwards
       -> [Row (a, Set a)]
genRow alphabet = go (Set.size alphabet) Set.empty where
  go n left ~(above:aboves)
    | n > 0 = do
        sym <- Set.toList (alphabet \\ left \\ above)
        let element = (sym, Set.singleton sym <> above)
        (element:) <$> go (n-1) (Set.singleton sym <> left) aboves
    | otherwise = pure []