Sudoku.hs

module Sudoku where

import Data.Map (Map)
import qualified Data.Map as Map
import Data.Char
import Data.List

newtype Board = Board (Map (Int, Int) Int)

instance Show Board where
    show (Board mp) = unlines $ map (\row -> concatMap (\col -> show $ mp Map.! (col, row)) [1..9]) [1..9]

fromString :: String -> Board
fromString str = Board $ Map.fromList $ zip [(x, y) | y <- [1..9], x <- [1..9]] $ map digitToInt str

validNumbers :: [Int] -> Bool
validNumbers nums = all (== 1) $ map length $ group $ sort $ filter (/= 0) nums

valid :: Board -> Bool
valid (Board mp) = horizontal && vertical && blocks
    where horizontal = all (\row -> validNumbers $ sort $ map (\col -> mp Map.! (col, row)) [1..9]) [1..9]
          vertical   = all (\col -> validNumbers $ sort $ map (\row -> mp Map.! (col, row)) [1..9]) [1..9]
          blocks     = all (uncurry validBlock) [(i, j) | i <- [0..2], j <- [0..2]]
          validBlock i j = validNumbers $ sort $ map (mp Map.!) [(x + i * 3 , y + j * 3) | x <- [1..3], y <- [1..3]]

solve :: Board -> [Board]
solve (Board mp) = case filter ((== 0) . (mp Map.!)) [(x, y) | x <- [1..9], y <- [1..9]] of
    [] -> [Board mp]
    ((x, y) : _) -> concatMap solve $ filter valid $ map (\n -> Board $ Map.insert (x, y) n mp) [1..9]