module System.IO.Streams.Lzma
(
decompress
, decompressWith
, Lzma.defaultDecompressParams
, Lzma.DecompressParams
, Lzma.compressIntegrityCheck
, Lzma.compressLevel
, Lzma.compressLevelExtreme
, compress
, compressWith
, Lzma.defaultCompressParams
, Lzma.CompressParams
, Lzma.decompressTellNoCheck
, Lzma.decompressTellUnsupportedCheck
, Lzma.decompressTellAnyCheck
, Lzma.decompressConcatenated
, Lzma.decompressAutoDecoder
, Lzma.decompressMemLimit
, Lzma.IntegrityCheck(..)
, Lzma.CompressionLevel(..)
) where
import Codec.Compression.Lzma (DecompressStream(..), CompressStream(..))
import qualified Codec.Compression.Lzma as Lzma
import Control.Exception
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.IORef
import Data.Maybe
import System.IO.Streams (InputStream, OutputStream,
makeInputStream, makeOutputStream)
import qualified System.IO.Streams as Streams
decompress :: InputStream ByteString -> IO (InputStream ByteString)
decompress = decompressWith Lzma.defaultDecompressParams
decompressWith :: Lzma.DecompressParams -> InputStream ByteString -> IO (InputStream ByteString)
decompressWith parms ibs = do
st <- newIORef =<< Lzma.decompressIO parms
makeInputStream (go st)
where
go stref = do
st' <- goFeed =<< readIORef stref
case st' of
DecompressInputRequired _ -> do
writeIORef stref st'
fail "the impossible happened"
DecompressOutputAvailable outb next -> do
writeIORef stref =<< next
return (Just outb)
DecompressStreamEnd leftover -> do
unless (BS.null leftover) $ do
Streams.unRead leftover ibs
writeIORef stref (DecompressStreamEnd BS.empty)
return Nothing
DecompressStreamError rc -> do
writeIORef stref st'
throwIO rc
goFeed (DecompressInputRequired supply) =
goFeed =<< supply . fromMaybe BS.empty =<< getChunk
goFeed s = return s
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 Lzma.defaultCompressParams
compressWith :: Lzma.CompressParams -> OutputStream ByteString -> IO (OutputStream ByteString)
compressWith parms obs = do
st <- newIORef =<< Lzma.compressIO parms
makeOutputStream (go st)
where
go stref (Just chunk) = do
st <- readIORef stref
st' <- case st of
CompressInputRequired flush supply
| BS.null chunk -> goOutput True =<< flush
| otherwise -> goOutput False =<< 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 False =<< supply BS.empty
_ -> fail "compressWith[EOF]: unexpected state"
writeIORef stref st'
case st' of
CompressStreamEnd -> return ()
_ -> fail "compressWith[EOF]: unexpected state"
goOutput flush st@(CompressInputRequired _ _) = do
when flush $
Streams.write (Just BS.empty) obs
return st
goOutput flush (CompressOutputAvailable obuf next) = do
Streams.write (Just obuf) obs
goOutput flush =<< next
goOutput _ st@CompressStreamEnd = do
Streams.write Nothing obs
return st