import System.Environment
import System.IO
import Data.List

type Cell = (Int,Int)
type F = Cell -> [Int]

allCells :: [Cell]
allCells = [(i,j) | i <- [1..9],
                   j <- [1..9]]

-- Solver
                   
solveSudoku :: [F] -> [F]
solveSudoku fl = foldr searchFor fl allCells
--
-- Iterate over all cells (from the right) with 'foldr' and apply
-- the function 'searchFor' to each cell with the list 'fl' of
-- possible values, the function 'searchFor' produces a new list
-- of possible values; then, the 'searchFor' is called again with
-- the new list and the next cell, and so on.
   
searchFor ::  Cell -> [F] -> [F]
searchFor c fl' = [adjustCells (c,v) f | f <- fl',
                                         v <- f c]   
--
-- For the cell c try all possible values with 'v <- f c'
                                               
adjustCells :: (Cell,Int) -> F -> F
adjustCells (p@(i,j),v) t q@(x,y) =
  if p==q then [v] else
     if x==i || y==j || e x i && e y j
        then delete v (t q)
        else t q
     where e m n = (div (m-1) 3) == (div (n-1) 3)
--
-- If the value v is guessed for the cell (i,j), the possible
-- values of the affected cells are to be adjusted with 'delete v (f q)'

-- Input Output  
 
displaySolution :: F -> String
displaySolution f = unlines [unwords [show $ head (f (i,j))
                                | j <- [1..9]]
                                | i <- [1..9]]

ntoS :: (Show a) => [a] -> String
ntoS [] = ""
ntoS (x:xs) = (show x) ++ ntoS xs

fillS :: (Show a) => [a] -> String
fillS a = fst $ splitAt 9 $ (ntoS a) ++ "_________"                                 
                                
displayStep :: F -> String
displayStep f = unlines [unwords [fillS (f (i,j))
                                | j <- [1..9]]
                                | i <- [1..9]]                               
                                
getProblem :: String -> [(Cell,Int)]
getProblem s = [(p,v) | (p,v) <- zip allCells $ map read (lines s >>= words), v > 0]
--
-- The Sudoku to be solved, a list with the given numbers
-- [((1,3),5), ..., ((9,8),7)]

initializeSolver :: String -> F
initializeSolver s = foldr adjustCells (const [1..9]) (getProblem s)
--
-- All possible values for each cell adjusted with the given values
-- of the problem

-- Main

main = do
  args <- getArgs
  case args of
     [filename] -> do
        s <- readFile filename
        putStrLn "\n>>> The Sudoku problem is ...\n"
        putStrLn s
        putStrLn "\n>>> The first step ...\n"
        putStr $ unlines $ map displayStep [initializeSolver s]
        putStrLn ">>> Wait a while ...\n"
        let solutions = solveSudoku [initializeSolver s]
            nb = length solutions
        putStr $ unlines $ map displaySolution $ solutions
        putStr ">>> There are solutuions: "
        print nb
        --
     [] -> error "Usage: maggesi_sudoku.exe filename"
     _  -> error "Too many arguments"
--
-- The end