card picking.hs

import Control.Monad.State
import Data.List

type Count = Int
data Jolly a = None | Given a | Internal (a -> Bool) | Placed Int a

pick :: Eq a => (a -> Bool) -> [a] -> StateT (Int, Jolly a) [] [a]
pick k cs = do
	(i, mj) <- get
	let more = case mj of 
		Given c -> [Left c]
		Internal k' -> map Right $ filter k' cs
		_ -> []
	c <- lift $ map Right (filter k cs) ++ more
	let (mj',cs') = case c of 
		Left c -> (Placed i c, cs)
		Right c  -> (mj, delete c cs)
	put (i + 1, mj')
	return cs'

play :: Eq a => Jolly a -> Int -> [a -> Bool] -> [a] -> [[a]]
play j i ks cs = evalStateT (foldr (\k a -> a >>= pick k) (return cs) ks) (i,j)

playN :: (Eq a , Ord a) => Jolly a -> Int -> [a -> Bool] -> [a] -> [[a]]
playN j i ks cs = evalStateT (foldr z (return cs) ks) (i,j)
	where z k a = a >>= pick k . map head . group . sort