module Sudoku where

import Data.List
import Data.Monoid

sudoku :: [[Int]] -> [[Int]]
sudoku = head . getAnswers . return

    where getAnswers :: [[[Int]]] -> [[[Int]]]
          getAnswers = appEndo . mconcat $ map (Endo . flip (>>=) . tryCell) allPos

          setCell :: (Int,Int) -> [[Int]] -> Int -> [[Int]]
          setCell (i,j) xss n = zipWith f [0..] xss
              where f a xs
                        | a == j = zipWith g [0..] xs
                        | otherwise = xs
                    g  b x
                        | b == i = n
                        | otherwise = x

          readCell :: (Int,Int) -> [[Int]] -> Int
          readCell (i,j) = (!! i) . (!! j)

          tryCell :: (Int,Int) -> [[Int]] -> [[[Int]]]
          tryCell p s
              | readCell p s == 0 = filter validSolution $ map (setCell p s) [1..9]
              | otherwise = [s]

          allPos :: [(Int,Int)]
          allPos = let xs = [0..8]
                   in do i <- xs
                         j <- xs
                         return (i,j)

          validSolution :: [[Int]] -> Bool
          validSolution s = validateBy rows && validateBy cols && validateBy squares

              where validateBy f = all isValid . f $ s

                    rows = id

                    cols = transpose

                    squares p = let slices = do let xs = [0,3,6]
                                                a <- xs
                                                b <- xs
                                                return (a,b)
                                in map (slice p) slices
                        where slice puzzle (x,y) = let f = (take 3) . (drop y)
                                                       g = (take 3) . (drop x)
                                                   in f puzzle >>= g

                    isValid xs = let nonZeros = filter (/= 0) xs
                                 in nonZeros == nub nonZeros