pick.hs

{-# LANGUAGE PackageImports #-}
import Control.Monad
import Control.Applicative ((<$>),(<*>))
import "mtl" Control.Monad.RWS

import qualified System.Random as R



main = do
  g <- R.newStdGen
  print $ pick g [0,1,2,3,4,5,6,7,8,9] 4
  

pick :: R.RandomGen g => g -> [a] -> Int -> [a]
pick g xs c = snd $ execRWS (
  do
    let c' = (length xs) - c
    whileDo ( (c'<) . length . snd <$> get) $ do
      (g',xs) <- get
      let (i,g'') = R.randomR (0, (length xs)-1) g'
      tell [xs !! i]
      put (g'', reduce xs i)
  ) () (g,xs)
  where

    reduce :: [a] -> Int -> [a]
    reduce xs n = (take n xs) ++ (drop (n+1) xs)

    whileDo :: Monad m => m Bool -> m () -> m ()
    whileDo fcond fbody = loop
      where
        loop = do
          c <- fcond
          if c
            then fbody >> loop
            else return ()