{-# LANGUAGE NoMonomorphismRestriction #-}
import Data.List (sortBy, groupBy, minimumBy,partition,delete,intercalate)
import Data.Ord (comparing)
import Control.Arrow ((***),second,first)
import Data.Function (on)
import System.IO
import System.Random

----------------------- libreria ------------------------
groupOn :: Ord b => (a -> b)  -> [a] -> [[a]]
groupOn f = groupBy ((==) `on`  f) . sortBy (comparing f)

enumerate :: Int -> Int -> [[Int]]
enumerate n m = sequence $ replicate n [1..m]
----------------------------------------------------------

type Secret 	= [Int]
type Guess 	= [Int]
type Answer 	= (Int,Int) 

answer :: Secret -> Guess -> Answer
answer xs = (length *** s) . partition (uncurry (==)) . zip xs 
	where
	f  x (n,ys) 	| x `elem` ys = (n + 1, delete x ys)
			| otherwise = (n,ys)
	s xys = fst $ foldr f (0,ys') xs' where
		(xs',ys') = unzip xys

choice :: [Secret] -> [Guess] ->  Guess
choice ss = minimumBy (comparing valg) where
	valg g = maximum . map length . groupOn id . map (answer g) $ ss

shrink :: Guess -> Answer -> [Secret] -> [Secret]
shrink g a = filter ((==) a . answer g)

main :: IO () 
main = do
	ws <- randomRs (0,1) `fmap` newStdGen :: IO [Float]
	let 	prompt x = putStr x >> hFlush stdout
		readAns = foldr f (0,0) where
			f 'b' = second (+1)
			f 'n' = first (+1)
			f _ = id
		showGuess = intercalate " " . map show 
		gs = map snd . sortBy (comparing fst) . zip ws $ enumerate 4 6
		turn [] = print $ "incapace!"
		turn [s] = print $ s
		turn ss = do
			let g = choice ss gs
			prompt "tentativo: "
			putStrLn . showGuess $ g 
			prompt "risposta : "
			a <- getLine
			turn $ shrink g (readAns a) ss
	turn gs