module Main where

import List
import Char

import Text.Html
import Network.CGI
import System.Directory

import System.Random

type Sudoku = [[Value]]

data Value = Fix Int | User Int | Free
  deriving (Show,Read,Eq)

valueToInt :: Value -> Int
valueToInt (Fix n) = n
valueToInt (User n) = n

user2fix :: Value -> Value
user2fix (User n) = Fix n
user2fix v = v

checkSudoku :: Sudoku -> Bool
checkSudoku s = all (all check) [sLines s, sCols s, sSquares s]

check :: [Value] -> Bool
check xs = ys == nub ys
 where
  ys = map valueToInt (filter (/=Free) xs)

solvedSudoku :: Sudoku -> Bool
solvedSudoku = all (/=Free) . concat
             

sLines :: Sudoku -> [[Value]]
sLines = id

sCols :: Sudoku -> [[Value]]
sCols s = transpose s

sSquares :: [[a]] -> [[a]]
sSquares = concat.map (map concat).map transpose.byThree.map byThree

byThree :: [a] -> [[a]]
byThree (x:y:z:xs) = [x,y,z]:byThree xs
byThree _ = []

(%) :: Sudoku -> (Int,Int) -> Value
s % (i,j) = s!!(j-1)!!(i-1)

emptySudoku :: Sudoku
emptySudoku = replicate 9 (replicate 9 Free)

sudokuToHtml :: Sudoku -> Html
sudokuToHtml s =
  simpleTable [border 1] [align "center"]
     (byThree $ map (simpleTable [border 1] [align "center"])
                    (map byThree 
		         (sSquares (map (map (fieldToHtml s)) 
                                        [[(i,j) | i <- [1..9]]
                                                | j <- [1..9]]))))

fieldToHtml :: Sudoku -> (Int,Int) -> Html
fieldToHtml s pos = 
  let v = s%pos in
    case v of
      Fix n -> stringToHtml (show n) +++ hidden (fieldName pos) (show v)
      _     ->
        input![name (fieldName pos),
               value (if v==Free then "" else show (valueToInt v)),
               maxlength 1,size "1"]

fieldName :: (Int,Int) -> String
fieldName pos = "v"++show pos

sudokuFromForm :: [(String,String)] -> Sudoku
sudokuFromForm env = [[ getFormInfo env (i,j) | i <- [1..9]] | j <- [1..9]]

getFormInfo :: [(String,String)] -> (Int,Int) -> Value
getFormInfo env pos = 
           case lookup (fieldName pos) env of
             Just str | null str        -> Free
                      | all isDigit str -> let n=read str in
                                             if n==0 then Free 
                                                     else User n
		      | otherwise       -> 
                            case reads str of
                                   ((v,""):_) -> v
                                   _          -> Free

readCompact :: String -> Sudoku
readCompact = (map.map) val.map concat.byThree.byThree
 where
  val c = let n = read [c]
           in if n == 0 then Free else Fix n

cgi :: [(String,String)] -> IO Html
cgi env = do
  writeFile "Sudoku/debug" (unlines (map show env))
  files <- getFiles
  sudoku <- 
       case lookup "submit" env of
         Nothing ->  return emptySudoku
         Just "Load" -> 
             maybe (return emptySudoku)
                   (\fileName -> do
                       str <- readFile ("Sudoku/"++fileName)
                       return (read str))
                   (lookup "file" env)
         Just "Check" -> return (sudokuFromForm env)
         Just "Save" -> do
           let name = show $ head $ filter (not . (`elem`map read files)) [1..]
               sud  = sudokuFromForm env
           if checkSudoku sud
            then writeFile ("Sudoku/"++name) $ show ((map.map) user2fix sud)
            else return ()
           return sud
         Just "New" -> do
           sudoku17 <- readFile ("Sudoku/sudoku17.txt") >>= return . lines
           idx <- randomRIO (0, 36627)
           return $ readCompact $ sudoku17!!idx
  files <- getFiles
  return $ body (form (
           sudokuToHtml sudoku
       +++ submit "submit" "Check"
       +++ select (toHtml (map (option . stringToHtml) files))!
               [name "file"]
       +++ submit "submit" "Load"
       +++ submit "submit" "Save"
       +++ submit "submit" "New")!
             [action "sudoku.cgi",
              method "post"])
           !if checkSudoku sudoku
              then if solvedSudoku sudoku then [bgcolor "green"] else []
              else [bgcolor "red"]
 where
  getFiles = getDirectoryContents "Sudoku" >>= return . filter (all isDigit)

main :: IO ()
main = wrapper cgi
 -- sequence (replicate 1 getLine) >>= writeFile "Sudoku/debug" . unlines