Random Code, Permutations, and unsafePerformIO

Permutation.hs

module Permutation
  ( permute         -- :: RandomGen g => [a] -> g -> ([a], g)
  , permuteST       -- :: RandomGen g => [a] -> g -> ST s ([a], g)
  , permuteIO       -- :: [a] -> IO [a]
  , unsafePermute   -- :: [a] -> [a]
  ) where

import Control.Monad ( foldM )
-- N.B. Unsafe operations have been deprecated in the original module and have
-- been moved to Control.Monad.ST.Unsafe.
import Control.Monad.ST hiding ( unsafeIOToST )
import Control.Monad.ST.Unsafe ( unsafeIOToST )

import Data.Array.MArray
import Data.Array.ST

import System.IO.Unsafe ( unsafePerformIO )
import System.Random


permute :: RandomGen g => [a] -> g -> ([a], g)
permute g xs = runST (permuteST g xs)

{-# NOINLINE unsafePermute #-}
unsafePermute :: [a] -> [a]
unsafePermute xs = unsafePerformIO (permuteIO xs)

permuteIO :: [a] -> IO [a]
permuteIO xs = do
    stdGen   <- getStdGen
    (xs', _) <- stToIO (permuteST xs stdGen)
    return xs'

permuteST :: RandomGen g => [a] -> g -> ST s ([a], g)
permuteST xs gen = do
    let len = length xs
    array <- newListArray (0, len - 1) xs

    let rswap g i = let (j, g) = randomR (i, len - 1) g
                      in swap array i j >> return g

    gen' <- foldM rswap gen [0..len -1]
    xs'  <- getElems array
    return (xs', gen')

swap :: (Ix i) => STArray s i e -> i -> i -> ST s ()
swap a i j = do
    e1 <- readArray a j
    e2 <- readArray a i
    writeArray a i e1
    writeArray a j e2