main = do 
  putStrLn "Enter your sudoku:"
  sudoku <- getLine
  if valid sudoku
    then putStrLn $ sayresult $ solve $ format sudoku
    else putStrLn "Sorry, your sudoku doesn't have the right format."

sayresult (c,x) = if c == 0 then "This sudoku is unsolvable." else if c == 1 then "Found an unique solution: " ++ x else "There are multiple solutions."

valid s = (length s == 81) && (validchar s)
  where validchar = all (`elem` ['1','2','3','4','5','6','7','8','9','0','*','_','.'])

format = map rewrite
  where rewrite a = if elem a ['*', '_', '.'] then '0' else a
  
solve s = sol 0 s
  where sol 81 x = (1, x)
        sol i x
          | (x !! i) /= '0' = sol (i+1) x
          | otherwise       = foldr (merge x) (0, x) [sol (i+1) a | a <- [take i x ++ [b] ++ drop (i + 1) x | b <- ['1','2','3','4','5','6','7','8','9']], not (violates a i)]
        merge x t1 t2 = if fst t1 == 2 then t1 else if fst t2 == 2 then t2 else if fst t1 == 1 && fst t2 == 1 then (2,x) else if fst t1 == 1 then t1 else t2

violates s i = (s !! i) /= '0' && elem (s !! i) ((getrow i) ++ (getcol i) ++ (getsq i))
  where getrow i = [s !! a | a <- [(div i 9)*9..(div i 9 + 1)*9 - 1], a /= i]
        getcol i = [s !! a | a <- [i + b*9 | b <- [-9..9]], a >= 0 && a <= 80 && a /= i]
        getsq i  = [s !! a | a <- [b + (div i 27) * 27 + (div (mod i 9) 3) * 3 | b <- [0,1,2,9,10,11,18,19,20]], a /= i]

sample1 = format "...1.5..714..8.67..8...24...63.7..1.9.......3.1..9.52...72...8..26....35...4.9..."--Unsolvable
sample2 = format "...1.5...14....67..8...24...63.7..1.9.......3.1..9.52...72...8..26....35...4.9..."--Solvable with unique solution
sample3 = format "................................................................................."--Many solutions