sudoku generation in Haskell

sudoku.hs

module Main where

import Data.List (minimumBy)
import Data.Ord (comparing)
import Data.Maybe (fromJust)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

-- Unknown: a list of ((x,y), options) for each cell (x,y).
type Unknown = [((Int, Int), [Int])]
type Known = Map (Int, Int) Int

allUnknown :: Unknown
allUnknown = [((x,y), [1..9]) | x <- [1..9], y <- [1..9]]

solve :: (Known, Unknown) -> [Known]
solve (known, []) = [known]
-- Backtrack over the possible assignments to the most constrained choice.
solve (known, unknown) = solve =<< update k =<< vs
  where
    (k,vs) = minimumBy (comparing (length . snd)) unknown --most constrained choice
    update k@(x,y) v
      | Just unknown' <- assign unknown k v = [(Map.insert k v known, unknown')]
      | otherwise = []

-- Updates the unknown set by an assignment, removing choices that conflict with it.
assign :: Unknown -> (Int,Int) -> Int -> Maybe Unknown
assign unknown k@(x,y) v = mapM removeConflicts $ filter ((/= k) . fst) unknown
  where removeConflicts :: ((Int, Int), [Int]) -> Maybe ((Int, Int), [Int])
        removeConflicts entry@(k'@(x',y'), vs)
          | conflict k k' = case filter (/= v) vs of
                              [] -> Nothing
                              vs' -> Just (k', vs')
          | otherwise = return entry

conflict :: (Int,Int) -> (Int,Int) -> Bool
conflict (x,y) (x',y')
  | x == x' && y == y' = error "shouldn't happen"
  | x == x' || y == y' = True
  -- Note the off-by-one because we use numbers 1..9 not 0..8
  | otherwise = quot (x-1) 3 == quot (x'-1) 3 && quot (y-1) 3 == quot (y'-1) 3

main = mapM_ (print . toMatrix) (solve (Map.empty, allUnknown))
toMatrix :: Known -> [[Int]]
toMatrix k = [[k Map.! (x,y) | y <- [1..9]] | x <- [1..9]]