gistfile1.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BangPatterns #-}
 
module Main where
 
import Data.Word
import Data.Array.ST
import Data.Array.Base (unsafeRead, unsafeWrite)
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe (unsafeIndex)
import Control.Monad.ST (ST, runST)
import qualified Data.ByteString as BStr
 
s :: ByteString
s = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
 
type CharArray s = (STUArray s) Int Word8
 
salted_shuffle :: ByteString -> ByteString -> ByteString
salted_shuffle input salt = BStr.pack $ runST $ do
    input' <- newListArray (0, last) $ BStr.unpack input :: ST s (CharArray s)
    loop input' last (fromIntegral $ unsafeIndex salt 0) 0
    getElems input'
    where
    loop !arr !ind !summ !grainpos = if ind < 1 then return ()
        else do
            k <- unsafeRead arr ind
            unsafeRead arr alt >>= unsafeWrite arr ind >> unsafeWrite arr alt k
            loop arr (ind - 1) (summ + grain') grainpos'
        where
        grain = fromIntegral $ unsafeIndex salt grainpos
        grain' = fromIntegral $ unsafeIndex salt grainpos'
        grainpos' = (grainpos + 1) `rem` BStr.length salt
        alt = (summ + grainpos + grain) `rem` ind
 
    last = BStr.length input - 1

shuffleN :: ByteString -> Int -> ByteString
shuffleN !b !0 = b
shuffleN !b !n = shuffleN (salted_shuffle b b) (n-1)

main :: IO ()
main = print $ shuffleN s 2000000
-- main = print . head . drop 2000000 . iterate (\ss -> salted_shuffle ss ss) $ s