{-# OPTIONS -O2 #-}

import Foreign
import Data.Array.IArray
import Data.Array.ST
import Control.Monad
import Control.Monad.ST.Strict
import System.IO
import System.Random
import System.Environment


main :: IO ()
main = do
    args <- getArgs
    when (null args) $ error "filename required"
    fh   <- openBinaryFile (head args) ReadMode
    sz   <- return . fromInteger =<< hFileSize fh
    allocaBytes sz $ \buf -> do
        hGetBuf fh buf sz
        ixs <- foldM (build buf) [-1] [0 .. sz-1]
        gen <- newStdGen
        let len = length ixs + 1
            stu :: ST s (STUArray s Int Int)
            stu = do
                arr <- newListArray (1, len) (sz-1:ixs)
                foldM_ (swap arr) gen [len `div` 2,(len `div` 2)-1..1]
                return arr
        display buf . elems $ runSTUArray stu

build :: Ptr Word8 -> [Int] -> Int -> IO [Int]
build buf ixs ix = do
    chr <- peek (plusPtr buf ix) :: IO Word8
    return $ if chr == 0o12 then (ix:ix:ixs) else ixs

swap arr g ix = do
    let (iy, g') = randomR (1, ix) g
    x1 <- readArray arr $ ix*2-1; x2 <- readArray arr $ ix*2
    y1 <- readArray arr $ iy*2-1; y2 <- readArray arr $ iy*2
    writeArray arr (ix*2-1) y1; writeArray arr (ix*2) y2
    writeArray arr (iy*2-1) x1; writeArray arr (iy*2) x2
    return g'

display buf [] = return ()
display buf (x1:x2:xs) = do
    hPutBuf stdout (plusPtr buf x2) (x1 - x2)
    display buf xs
[download]