{-#OPTIONS -O2  #-}

module Main where

import Control.Monad
import Data.Bits
import Data.Char
import Data.Word
import Data.Array.Unboxed
import Data.Array.IO
import System
import System.CPUTime
import System.IO
import Text.Printf
import Control.Exception

iterations :: Int
iterations = 10

main = do
    (f:_) <- getArgs
    arr   <- slurp f

    let force [x]    = let dx = decode x in last dx `seq` dx
        force (x:xs) = (last $ decode x) `seq` force xs

    t0    <- getCPUTime
    result <- evaluate $ force $ replicate iterations arr
    t1    <- getCPUTime

    writeFile (f ++ ".haskell") result
    printf "%.3f" $ 1.0e-12 * (fromInteger $ t1 - t0 :: Float)

--------------------------------------------------------------------------------------

data Tree = Leaf !Char                                                   	--1
          | Branch !Tree !Tree							--2

mkTree :: Buffer -> (Tree, Int)							
mkTree buff = (mkTree' 6 end, end)						--4
 where
    end = 6 + readSize 4							--5

    readSize i = shiftL (fromIntegral $ buff ! i) 8 .|. 			--6
                 (fromIntegral $ buff ! (i+1))					--7

    mkTree' low high								--8
     | high - low == 1 = Leaf (chr $ fromIntegral $ buff ! low)			--9
     | otherwise       = Branch (mkTree' lowL highL) (mkTree' lowR high)	--10
     where
        lowL  = low + 2								--11
        highL = lowL + readSize low						--12
        lowR  = highL + 2							--13

bitstream :: Buffer -> Word32 -> Int -> [Bool]
bitstream buff num i								--14
 | num < 8   = take (fromIntegral num) $ map (testBit b) [7, 6 .. 0]		--15
 | otherwise = (b .&. 128 == 128) : (b .&. 64 == 64)			   	--16
             : (b .&. 32 == 32) : (b .&. 16 == 16)				--17
             : (b .&. 8 == 8) : (b .&. 4 == 4)					--18
             : (b .&. 2 == 2) : (b .&. 1 == 1)					--19
             : bitstream buff (num - 8) (i + 1)					--20
 where
    b = buff ! i 								--21

decode :: Buffer -> [Char]
decode buff = loop tree (bitstream buff numBits (begin + 4))			--22
 where
    (tree, begin) = mkTree buff							--23

    numBits       = shiftL (fromIntegral $ buff ! begin)     24 .|.	 	--24
                    shiftL (fromIntegral $ buff ! (begin+1)) 16 .|.		--25
                    shiftL (fromIntegral $ buff ! (begin+2)) 8  .|.		--26
                           (fromIntegral $ buff ! (begin+3))			--27

    loop (Branch l r) (b:bs) = if b then loop r bs else loop l bs		--28
    loop (Leaf c) bs         = c : loop tree bs					--29
    loop _ []                = []						--30


-----------------------------------------------------------------------------------------
{-
IO code adapted from drop3.hs
-}

type Buffer = UArray Int Word8

slurp :: FilePath -> IO Buffer
slurp f = do
    h   <- openBinaryFile f ReadMode
    l   <- hFileSize h
    arr <- newArray_ (0,fromIntegral l-1)
    hGetArray h arr (fromIntegral l)
    hClose h
    unsafeFreeze arr