import Data.Maybe
import Data.List
import Data.Char
import Test.QuickCheck

data Sudoku = Sudoku [[Maybe Int]] 

showElement :: Maybe Int -> String
showElement (Nothing) = "."
showElement (Just a) = show a

showSudoku :: Sudoku -> String
showSudoku (Sudoku s) = concatMap (\x->(concatMap showElement x)++"\n") s

instance Show Sudoku where
    show = showSudoku

example :: Sudoku
example =
    Sudoku
      [ [Just 3, Just 6, Nothing,Nothing,Just 7, Just 1, Just 2, Nothing,Nothing]
      , [Nothing,Just 5, Nothing,Nothing,Nothing,Nothing,Just 1, Just 8, Nothing]
      , [Nothing,Nothing,Just 9, Just 2, Nothing,Just 4, Just 7, Nothing,Nothing]
      , [Nothing,Nothing,Nothing,Nothing,Just 1, Just 3, Nothing,Just 2, Just 8]
      , [Just 4, Nothing,Nothing,Just 5, Nothing,Just 2, Nothing,Nothing,Just 9]
      , [Just 2, Just 7, Nothing,Just 4, Just 6, Nothing,Nothing,Nothing,Nothing]
      , [Nothing,Nothing,Just 5, Just 3, Nothing,Just 8, Just 9, Nothing,Nothing]
      , [Nothing,Just 8, Just 3, Nothing,Nothing,Nothing,Nothing,Just 6, Nothing]
      , [Nothing,Nothing,Just 7, Just 6, Just 9, Nothing,Nothing,Just 4, Just 3]
      ]

-- rows extracts the actual rows from the Sudoku
rows :: Sudoku -> [[Maybe Int]]
rows (Sudoku rs) = rs

-- allBlankSudoku represents a Sudoku that only contains blank cells
allBlankSudoku :: Sudoku
allBlankSudoku = Sudoku $ take 9 (repeat ( take 9 (repeat Nothing) ))

-- isSudoku 
isSudoku :: Sudoku -> Bool
isSudoku (Sudoku s) | length s /= 9 = False
isSudoku (Sudoku s) | map length s /= take 9 (repeat 9) = False
isSudoku (Sudoku s) = and (map (\x->(isNothing x || fromJust x `elem` [1..9])) (concat s))

-- isSolved
isSolved :: Sudoku -> Bool
isSolved (Sudoku s) = not $ elem Nothing (concat s)

-- printSudoku: print the Sudoku on the screen
printSudoku :: Sudoku -> IO ()
printSudoku s = putStr (show s)

-- readSudoku
readSudoku :: FilePath -> IO Sudoku
readSudoku fn =
    do sudokuData <- readFile fn
       return (Sudoku (map
                       (map (\x->(if x=='.' then Nothing else Just $ digitToInt x)))
                       $ lines sudokuData))

-- generate a cell
cell :: Gen (Maybe Int)
cell = frequency
       [ (1, do a <- elements [1..9]
                return (Just a)),
         (9, return Nothing)
       ]

-- C2. Make Sudokus an instance of the class Arbitrary. 
instance Arbitrary Sudoku where
    arbitrary = do grid <- sequence (replicate 9 (sequence (replicate 9 cell)))
                   return (Sudoku grid)

prop_Sudoku :: Sudoku -> Bool
prop_Sudoku s = isSudoku s

type Block = [Maybe Int]

-- isOkayBlock
isOkayBlock :: Block -> Bool
isOkayBlock b = length (nub y) == length y where y = [ x | x <- b, isJust x ]

groupn :: Int -> [a] -> [[a]]
groupn _ [] = []
groupn n xs = (take n xs):(groupn n (drop n xs))

-- blocks
linesSudoku (Sudoku s) = s
columnsSudoku (Sudoku s) = transpose s
gridsSudoku (Sudoku s) = map concat $ concatMap (groupn 3) (map transpose (groupn 3 s))
blocks :: Sudoku -> [Block]
blocks s = linesSudoku s ++ columnsSudoku s ++ gridsSudoku s
prop_Blocks s = length (blocks s) == 27 && and (map (==9) (map length (blocks s)))

-- isOkay
isOkay :: Sudoku -> Bool
isOkay s = and (map isOkayBlock (blocks s))

type Pos = (Int,Int)

-- blank returns a blank position
hasBlank :: Sudoku -> Maybe Int
hasBlank (Sudoku s) = findIndex isNothing (concat s)

toPos :: Int -> Pos
toPos n = (n `div` 9, n `mod` 9)
blank :: Sudoku -> Pos
blank (Sudoku s) = toPos $ (fromJust (findIndex isNothing (drop n (concat s))))+n
                   where n = 9*fewestNothingLine s
blank (Sudoku s) = toPos (fromJust (findIndex (isNothing) (concat s)))

fewestNothingLine :: [[Maybe Int]] -> Int
fewestNothingLine s = snd $ minimum (filter (\x->fst x/=0)
                                                (zip
                                                 (map length (map (filter isNothing) s))
                                                 [0..8]))
fewestNothingCol s = fewestNothingLine (transpose s)

prop_Blankcell :: Sudoku -> Property
prop_Blankcell ss@(Sudoku s) =
    elem Nothing (concat s) ==> (s !! x) !! y == Nothing where (x,y)=blank ss

-- (!!=) updates a list 
(!!=) :: [a] -> (Int,a) -> [a]
(!!=) [] _ = []
(!!=) (x:xs) (0,a) = a:xs
(!!=) (x:xs) (n,a) = x:(xs !!= (n-1,a))

prop_idxReplacs xs (n,x) =
    n >=0 && length xs > n ==> (xs !!= (n,x)) !! n == x
prop_ReplaceTake xs (n,x) =
    n >=0 ==> take n (xs !!= (n,x)) == take n xs
prop_ReplaceDrop xs (n,x) =
    n >=0 ==> drop (n+1) (xs !!= (n,x)) == drop (n+1) xs

-- update update a Sudoku
update :: Sudoku -> Pos -> Maybe Int -> Sudoku
update (Sudoku s) (x,y) a = Sudoku (s !!= (x, (s !! x) !!= (y, a)))

data Position = Position (Int,Int) deriving Show
instance Arbitrary Position where
    arbitrary = do x <- elements [0..8]
                   y <- elements [0..8]
                   return (Position (x,y))

prop_update :: Sudoku -> Position -> Maybe Int -> Property
prop_update s (Position pos@(x,y)) a =
    x `elem` [0..8] && y `elem` [0..8] ==>
      getElem (update s pos a) pos == a
          where getElem (Sudoku s) (x,y) = (s !! x) !! y


solve :: Sudoku -> Maybe Sudoku
solve s | not (isOkay s) = Nothing
solve s | isNothing (hasBlank s) = Just s
solve s = solveAux s (blank s) 1

solveAux :: Sudoku -> Pos -> Int -> Maybe Sudoku
solveAux _ _ 10 = Nothing
solveAux s (x,y) a = if isNothing result then
                         solveAux s (x,y) (a+1)
                     else
                         result
    where news = update s (x,y) (Just a)
          result = solve news

readAndSolve :: FilePath -> IO ()
readAndSolve fn =
    do su <- readSudoku fn
       let result = solve su
       if isNothing result then
           putStrLn "(no solution)"
       else
           printSudoku (fromJust result)

-- isSolutionOf  checks, given two Sudokus,
-- whether the first one is a solution (i.e. all blocks are okay, there are no blanks), 
-- and also whether the first one is a solution of the second one 
isSolutionOf :: Sudoku -> Sudoku -> Bool
isSolutionOf s1 _ | not (isOkay s1) = False
isSolutionOf s1 _ | isJust (hasBlank s1) = False
isSolutionOf (Sudoku s1) (Sudoku s2) =
    f s1 == f s2 where
        f xs = [ (xs !! x) !! y | x <- [0..8], y <- [0..8], isJust ((s2 !! x) !! y) ]

prop_SolveSound :: Sudoku -> Property
prop_SolveSound s =
    collect
    s
    $ isJust (solve s) ==> isSolutionOf (fromJust (solve s)) s

fewerCheck prop = quickCheckWith stdArgs{ maxSuccess = 30 } prop