module System.IO.Streams.Lzma
(
decompress
, decompressWith
, defaultDecompressParams
, DecompressParams(..)
, compress
, compressWith
, defaultCompressParams
, CompressParams(..)
, IntegrityCheck(..)
, CompressionLevel(..)
) where
import Control.Exception
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.IORef
import LibLzma
import System.IO.Streams (InputStream, OutputStream, makeInputStream,
makeOutputStream)
import qualified System.IO.Streams as Streams
decompress :: InputStream ByteString -> IO (InputStream ByteString)
decompress = decompressWith defaultDecompressParams
decompressWith :: DecompressParams -> InputStream ByteString -> IO (InputStream ByteString)
decompressWith flags ibs
= newDecodeLzmaStream flags >>= either throwIO (wrapLzmaInStream ibs)
wrapLzmaInStream :: InputStream ByteString -> LzmaStream -> IO (InputStream ByteString)
wrapLzmaInStream ibs ls0 = do
st <- newIORef (Right ls0)
makeInputStream (go st)
where
go st = readIORef st >>= either goLeft goRight
where
goRight ls = do
ibuf <- getChunk
(rc, _, obuf) <- case ibuf of
Nothing -> runLzmaStream ls BS.empty True bUFSIZ
Just bs -> do
retval@(_, consumed, _) <- runLzmaStream ls bs False bUFSIZ
when (consumed < BS.length bs) $ do
Streams.unRead (BS.drop consumed bs) ibs
return retval
unless (rc == LzmaRetOK) $ do
writeIORef st (Left rc)
unless (rc == LzmaRetStreamEnd) $
throwIO rc
case rc of
LzmaRetOK -> if (BS.null obuf)
then goRight ls
else return (Just obuf)
LzmaRetStreamEnd -> do
writeIORef st (Left rc)
if BS.null obuf
then return Nothing
else return (Just obuf)
_ -> writeIORef st (Left rc) >> throwIO rc
goLeft err = case err of
LzmaRetStreamEnd -> return Nothing
_ -> throwIO err
bUFSIZ = 32752
getChunk = do
mbs <- Streams.read ibs
case mbs of
Just bs | BS.null bs -> getChunk
_ -> return mbs
compress :: OutputStream ByteString -> IO (OutputStream ByteString)
compress = compressWith defaultCompressParams
compressWith :: CompressParams -> OutputStream ByteString -> IO (OutputStream ByteString)
compressWith parms obs = do
st <- newIORef =<< compressIO parms
makeOutputStream (go st)
where
go stref (Just chunk)
| BS.null chunk = return ()
| otherwise = do
st <- readIORef stref
st' <- case st of
CompressInputRequired supply -> goOutput =<< supply chunk
_ -> fail "compressWith: unexpected state"
writeIORef stref st'
case st' of
CompressInputRequired _ -> return ()
_ -> fail "compressWith: unexpected state"
go stref Nothing = do
st <- readIORef stref
st' <- case st of
CompressInputRequired supply -> goOutput =<< supply BS.empty
_ -> fail "compressWith[EOF]: unexpected state"
writeIORef stref st'
case st' of
CompressStreamEnd -> return ()
_ -> fail "compressWith[EOF]: unexpected state"
goOutput st@(CompressInputRequired _) = do
return st
goOutput (CompressOutputAvailable obuf next) = do
Streams.write (Just obuf) obs
goOutput =<< next
goOutput st@CompressStreamEnd = do
Streams.write Nothing obs
return st