Codec-Compression-LZF-0.2: example/unlzf.hs

import Codec.Compression.LZF (decompress)
import Control.Exception (bracket)
import Control.Monad (when)
import Data.Char (ord)
import Data.List (isSuffixOf)
import Foreign (allocaBytes)
import Foreign.C (peekCStringLen)
import System (getArgs)
import System.IO 

buffer = 0xFFFF

norm lzfFile = case break (== '.') (reverse lzfFile) of
                (_,rfile) -> reverse (tail rfile)

decompressFile file = do
  allocaBytes buffer $ \inp ->
    allocaBytes buffer $ \out -> do
      bracket (openBinaryFile file WriteMode) hClose $ \oh ->
        bracket (openBinaryFile (file++".lzf") ReadMode) hClose $ \ih -> 
          work inp out ih oh

get5 h = allocaBytes 5 (\ptr -> hGetBuf h ptr 5 >>= \n -> peekCStringLen (ptr,n))

work inp out ih oh = do
  header <- get5 ih
  case header of 
   ['L','Z','\0',h,l] -> do let len = (ord h * 0x100) + ord l
                            hGetBuf ih inp len
                            hPutBuf oh inp len
                            work inp out ih oh
   ['L','Z','\1',h,l] -> do let len = (ord h * 0x100) + ord l
                            n <- hGetBuf ih inp len
                            when (n /= len) $ fail "Error reading compressed input file"
                            r <- decompress inp len out buffer
                            hPutBuf oh out r
                            work inp out ih oh
   []                 -> return ()
   _                  -> fail ("Invalid LZF superblock: "++show header)

main = do
  args <- getArgs 
  case args of
   [file] | ".lzf" `isSuffixOf` file -> decompressFile (norm file)
          | otherwise                -> putStrLn "Filename should end in '.lzf'"
   _      -> putStrLn "Usage: unlzf filename"