import qualified Data.List as List

type Cell     = Char
type Table    = [[Cell]]
type ClueLine = [Int]
type Clues    = ([ClueLine], [ClueLine])

unknown = 'u'
empty   = 'e'
full    = 'f'

duckClues  = (duckRows, duckCols)    :: Clues
poundClues = (poundRows,  poundCols) :: Clues

duckRows = [[3], [5], [4,3], [7], [5], [3], [5], [1,8],
            [3,3,3], [7,3,2], [5,4,2], [8,2], [10], [2,3], [6]]

duckCols = [[3], [4], [5], [4], [5], [6], [3,2,1], [2,2,5],
            [4,2,6], [8,2,3], [8,2,1,1], [2,6,2,1], [4,6], [2,4], [1]]


poundRows = [[4], [2,1], [1,2], [2,2], [2], [8], [2], [8],
             [2], [2], [2,2,2], [6,3], [2,5,3], [2,2,6], [4,4]]

poundCols = [[2],[4],[2,1],[1,1,2,1],[1,1,4],[11],[12],
             [2,1,1,2],[1,1,1,3],[1,1,1,2],[1,1,1,2],[3,3],[2,3],[3],[2]]

yinYangClues :: Clues
yinYangClues = (yinYangRows, yinYangCols)

yinYangRows = [[8],[4,4],[2,6],[1,3,2],[3,3],[8],[6],[2,5],
               [1,2,4],[2,5],[4,5],[8]]
yinYangCols = [[4,4],[3,3],[2,2],[2,2,2],[1,3,2,1],[1,4,2],
               [7,3],[3,7],[2,6],[10],[8],[4]]

flowerClues :: Clues
flowerClues = (flowerRows, flowerCols)

flowerRows = [[2,2],[1,1,1],[1,1,1],[1,5,2],[1,2,2,1],[1,5,1],
              [2,1,3],[2,2],[1],[2,1,2],[3],[1]]
flowerCols = [[2],[1,1],[2,1],[1,3,1,1],[1,3,1,1],[3,2,1],[1,3,5],
              [1,3,1,1],[2,1,1],[1,1,1],[1,1],[2]]

showCell c
 | c == unknown = '?'
 | c == empty = ' '
 | c == full = '#'

showRow xs = "|" ++ [showCell a|a<-xs] ++ "|\n"

showTable xss = putStrLn(concat [showRow xs|xs<-xss])

empties n = [empty|a<-[1..n]]

fulls n = [full|a<-[1..n]]

placeOneBlock x n = [(empties i) ++ (fulls x) ++ empties (n-i-x)|i<-[0..(n-x)]]

emptyLineOptions [] n
 | n > 0 = [empties n]
 | otherwise = [[]]

emptyLineOptions (x:xs) n
 | (length xs) == 0 = placeOneBlock x n
 | (length xs) > 0 && ((x+sum xs+sum [1|i<-xs])-1) > n = []
 | otherwise = [empties i ++ fulls x ++ empties 1 ++ j|i<-[0..(n-(x+sum xs+sum [1|i<-xs]-1))],j<-(emptyLineOptions xs (n-x-i-1))]

isMatching c1 c2
 |c1==full && c2/=full = False
 |c1==empty && c2/=empty = False
 |otherwise = True

lineOptions xs ys
 |null[y|y<-ys,y/=unknown] = emptyLineOptions xs (length ys)
 |otherwise = [x|x<-emptyLineOptions xs (length ys),length([i|i<-[0..(length(ys)-1)],isMatching (ys!!i) (x!!i)])==length ys]

combineOption c1 c2
 |c1==full && c2==full = full
 |c1==empty && c2==empty = empty
 |otherwise = unknown

combineLineOptions [xs] = xs
combineLineOptions (xs:xss) = [combineOption (xs!!i) ((combineLineOptions xss)!!i)|i<-[0..((length xs)-1)]]

reduceLine xs ys
 |xs==[] = ys
 |otherwise = combineLineOptions (lineOptions xs ys)

reduceRows xss yss = [reduceLine (xss!!i) (yss!!i)|i<-[0..((length xss)-1)]]

reduceTable xss yss = List.transpose(reduceRows (snd xss) (List.transpose(reduceRows (fst xss) yss)))

emptyTable n m = [[unknown|i<-[1..m]]|j<-[1..n]]

recSolve xss yss
 | (reduceTable xss yss) /= yss = recSolve xss (reduceTable xss yss)
 | otherwise = yss

solve xss = recSolve xss (emptyTable (length (fst xss)) (length (snd xss)))

draw xss = showTable (solve xss)