I'll give it shot, but I'm also learning Haskell, so take this with a grain of salt :)

randWhile :: ([Int]->Bool) -> StdGen -> [Int]
randWhile predicate  = head . filter predicate . blocks 10 . randomRs (0,9)
    where
      blocks n xs = let (y,ys) = splitAt n xs in y : blocks n ys

main = newStdGen >>= print . randWhile (all even)

or if you prefer non point free notation (point full?)

randWhile :: ([Int]->Bool) -> StdGen -> [Int]
randWhile predicate rndGen  = head $ filter predicate $ blocks 10 $ randomRs (0,9) rndGen
    where
      blocks n xs = let (y,ys) = splitAt n xs in y : blocks n ys

main = do
  rndGen <- newStdGen
  print $ randWhile (all even) rndGen

2008/12/28 Luke Palmer <lrpalmer@gmail.com>
On Sun, Dec 28, 2008 at 2:39 PM, Nicholas O. Andrews <nandrews@vt.edu> wrote:
Hi all,

What's the best way to implement the following Python code in Haskell?
It is purposefully written in a functional style (and as a result will
kill your recursion stack every other run).
 
Here's my solution, using MonadRandom (from Hackage).  There may be more infinite-listy ways of doing it, but I wasn't able to make it come out clean.

import Control.Monad.Random

many n = sequence . replicate n

untilM p m = do
  x <- m
  if p x then return x else untilM p m

getList :: MonadRandom m => m [Int]
getList = many 10 $ getRandomR (0,9)

main = print =<< evalRandIO (untilM (all even) getList)


# begin Python
from random import *

def genList ():
   return [randint(0,9) for x in range(10)]

def randWhile (predicate):
   result = genList ()
   if predicate(result):
       return result
   else:
       return randWhile (predicate)

def allEven (list):
   return reduce(lambda x,y: x and y, [x%2 == 0 for x in list])

print randWhile (allEven)
# End Python

Thanks!
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe


_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe