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"