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"