Birthday guesser for nonuniform birthday distributions

Birthday.hs

import System.IO (hFlush, stdout)

-- Should have 366 entries with probability of being born on each day, but here's a smaller example
-- with just 7 days (let's say they're the probability of being born on each day of the week)
distribution :: [Double] 
distribution = [0.1, 0.1, 0.2, 0.0, 0.3, 0.1, 0.2] 

medianIndex :: [Double] -> Int
medianIndex xs = length . takeWhile (< half) $ scanl1 (+) xs
  where half = sum xs / 2

main :: IO ()
main = search 0 distribution
  where
    search :: Int -> [Double] -> IO ()
    search n [_]  = putStrLn $ "You were born on " ++ show n
    search n days = do
        let m  = max 1 $ medianIndex days  -- the max 1 part ensures we always make progress
        let n' = n + m
        putStr $ "Were you born on or after " ++ show n' ++ "? (y/n) "
        hFlush stdout
        answer <- getLine
        if take 1 answer == "y"
            then search n' (drop m days)
            else search n  (take m days)