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

import Codec.Compression.LZF (compress)
import Control.Exception (bracket)
import Data.Char (chr)
import Foreign (allocaBytes)
import System (getArgs)
import System.IO 

buffer = 0xFFFF

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

work inp out ih oh = do
  n <- hGetBuf ih inp buffer
  r <- compress inp n out (n-4)
  if r == 0 
     then hPutStr oh ("LZ\0"++lc n) >> hPutBuf oh inp n
     else hPutStr oh ("LZ\1"++lc r) >> hPutBuf oh out r
  if n < buffer then return () else work inp out ih oh

lc c = let (h,l) = c `divMod` 0x100 in [chr h, chr l]

main = do
  args <- getArgs 
  case args of
   [file] -> compressFile file
   _      -> putStrLn "Usage: lzf filename"