import Data.List

readPuzzle :: String -> [[Int]]
readPuzzle l = inNs 9 (map (read.(:[])) l)

buildPuzzle p = [ [ pos i j n |  (j,n) <- zip [1..9] l ] |  (i,l) <- zip [1..9] p ]
  where pos i j n = if n==0 then X i j else N n

inNs n = (\(a,b)->if null a then [] else a:inNs n b) . splitAt n

getLines  p = p
getCols   p = transpose p
getBlocks p = let [[a1,b1,c1],[a2,b2,c2],[a3,b3,c3]] = inNs 3 $ map (inNs 3) p
                  a `u` b = zipWith (++) a b
              in concat [a1`u`b1`u`c1,a2`u`b2`u`c2,a3`u`b3`u`c3]

clause p body =  "puzzle([\n"++concat (intersperse ",\n" (map line p))++"]) :-\n\n"++body++"."
  where line l = "        ["++concat (intersperse ", " (map pr l))++"]"

body p = domains p++",\n\n"
       ++differents (getLines p)++",\n\n"
       ++differents (getCols p)++",\n\n"
       ++differents (getBlocks p)++",\n\n"
       ++labelling p
  where domains p  = concat (intersperse ",\n" (map domainsL p))
        domainsL l = "  ["++concat (intersperse ", " [ pr x | x@(X i j) <- l ])++"] in 1..9"

        differents p = concat (intersperse ",\n" (map different p))
        different  l = "  all_different(["++concat (intersperse ", " (map pr l))++"])"

        labelling  p = concat (intersperse ",\n" (map labellingL p))
        labellingL l = "  label(["++concat (intersperse ", " [ pr x | x@(X i j) <- l ])++"])"

data Pos = X Int Int | N Int deriving Show

pr (X i j) = "X_"++show i++"_"++show j
pr (N n)   = "    "++show n

s17_412 = "000000051260000000008600000000071020040050000000000300000300400500900000700000000"
p=buildPuzzle $ readPuzzle s17_412

main = do
  writeFile "sudoku.pl" $ unlines 
    [":- module(sudoku,[main/0,puzzle/1])."
    ,":- use_module(library('clp/bounds'))."
    ,""
    , clause p (body p)
    ,""
    ,"show([])."
    ,"show([L|LS]):-writeln(L),show(LS)."
    ,""
    ,"main :- puzzle(P),show(P)."
    ]