Shuffle.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Conjure.Utils.Shuffle
-- Copyright   :  (c) Lemmih 2005-2006
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-----------------------------------------------------------------------------
module Conjure.Utils.Shuffle
    ( shuffle
    ) where

import Data.Array.IO
import Data.Array.MArray (MArray(..))
import Data.Array.Base (unsafeRead,unsafeWrite)

import System.IO.Unsafe

import System.Random

shuffle :: StdGen -> [e] -> [e]
shuffle _ []  = []
shuffle gen lst = unsafePerformIO $
                  do arr <- newListArray (0,length lst - 1) lst
                     shuffleArr gen arr

shuffleArr :: (RandomGen g) => g -> IOArray Int e -> IO [e]
shuffleArr gen arr
    = do b <- getBounds arr
         let loop _ 0 = return []
             loop gen' top
                 = unsafeInterleaveIO $
                   do let (n, gen'') = randomR (0, top-1) gen'
                      aObj <- unsafeRead arr n
                      bObj <- unsafeRead arr (top-1)
                      unsafeWrite arr n bObj
                      rest <- loop gen'' (top-1)
                      return (aObj:rest)
         loop gen (rangeSize b)