module Data.Conduit.Lzma (compress, decompress) where
import qualified Codec.Compression.Lzma as Lzma
import Control.Applicative as App
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Resource
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Conduit
import Data.Conduit.List (peek)
import Data.Maybe (fromMaybe)
import Data.Word
prettyRet
:: Lzma.LzmaRet
-> String
prettyRet :: LzmaRet -> String
prettyRet r :: LzmaRet
r = case LzmaRet
r of
Lzma.LzmaRetOK -> "Operation completed successfully"
Lzma.LzmaRetStreamEnd -> "End of stream was reached"
Lzma.LzmaRetUnsupportedCheck -> "Cannot calculate the integrity check"
Lzma.LzmaRetGetCheck -> "Integrity check type is now available"
Lzma.LzmaRetMemError -> "Cannot allocate memory"
Lzma.LzmaRetMemlimitError -> "Memory usage limit was reached"
Lzma.LzmaRetFormatError -> "File format not recognized"
Lzma.LzmaRetOptionsError -> "Invalid or unsupported options"
Lzma.LzmaRetDataError -> "Data is corrupt"
Lzma.LzmaRetBufError -> "No progress is possible"
Lzma.LzmaRetProgError -> "Programming error"
decompress
:: (MonadThrow m, MonadIO m)
=> Maybe Word64
-> ConduitM ByteString ByteString m ()
decompress :: Maybe Word64 -> ConduitM ByteString ByteString m ()
decompress memlimit :: Maybe Word64
memlimit =
DecompressParams -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
(MonadThrow m, MonadIO m) =>
DecompressParams -> ConduitM ByteString ByteString m ()
decompressWith DecompressParams
Lzma.defaultDecompressParams
{ decompressMemLimit :: Word64
Lzma.decompressMemLimit = Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
forall a. Bounded a => a
maxBound Maybe Word64
memlimit
, decompressAutoDecoder :: Bool
Lzma.decompressAutoDecoder = Bool
True
, decompressConcatenated :: Bool
Lzma.decompressConcatenated = Bool
True
}
decompressWith
:: (MonadThrow m, MonadIO m)
=> Lzma.DecompressParams
-> ConduitM ByteString ByteString m ()
decompressWith :: DecompressParams -> ConduitM ByteString ByteString m ()
decompressWith parms :: DecompressParams
parms = do
Maybe ByteString
c <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
peek
case Maybe ByteString
c of
Nothing -> IOError -> ConduitM ByteString ByteString m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IOError -> ConduitM ByteString ByteString m ())
-> IOError -> ConduitM ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ "Data.Conduit.Lzma.decompress: invalid empty input"
Just _ -> IO (DecompressStream IO)
-> ConduitT ByteString ByteString m (DecompressStream IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DecompressParams -> IO (DecompressStream IO)
Lzma.decompressIO DecompressParams
parms) ConduitT ByteString ByteString m (DecompressStream IO)
-> (DecompressStream IO -> ConduitM ByteString ByteString m ())
-> ConduitM ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecompressStream IO -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
DecompressStream IO -> ConduitT ByteString ByteString m ()
go
where
go :: DecompressStream IO -> ConduitT ByteString ByteString m ()
go s :: DecompressStream IO
s@(Lzma.DecompressInputRequired more :: ByteString -> IO (DecompressStream IO)
more) = do
Maybe ByteString
mx <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
case Maybe ByteString
mx of
Just x :: ByteString
x
| ByteString -> Bool
B.null ByteString
x -> DecompressStream IO -> ConduitT ByteString ByteString m ()
go DecompressStream IO
s
| Bool
otherwise -> IO (DecompressStream IO)
-> ConduitT ByteString ByteString m (DecompressStream IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO (DecompressStream IO)
more ByteString
x) ConduitT ByteString ByteString m (DecompressStream IO)
-> (DecompressStream IO -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecompressStream IO -> ConduitT ByteString ByteString m ()
go
Nothing -> IO (DecompressStream IO)
-> ConduitT ByteString ByteString m (DecompressStream IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO (DecompressStream IO)
more ByteString
B.empty) ConduitT ByteString ByteString m (DecompressStream IO)
-> (DecompressStream IO -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecompressStream IO -> ConduitT ByteString ByteString m ()
go
go (Lzma.DecompressOutputAvailable output :: ByteString
output cont :: IO (DecompressStream IO)
cont) = do
ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
output
IO (DecompressStream IO)
-> ConduitT ByteString ByteString m (DecompressStream IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (DecompressStream IO)
cont ConduitT ByteString ByteString m (DecompressStream IO)
-> (DecompressStream IO -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DecompressStream IO -> ConduitT ByteString ByteString m ()
go
go (Lzma.DecompressStreamEnd rest :: ByteString
rest) = do
if ByteString -> Bool
B.null ByteString
rest
then () -> ConduitT ByteString ByteString m ()
forall (f :: * -> *) a. Applicative f => a -> f a
App.pure ()
else ByteString -> ConduitT ByteString ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
rest
go (Lzma.DecompressStreamError err :: LzmaRet
err) =
IOError -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (IOError -> ConduitT ByteString ByteString m ())
-> IOError -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ "Data.Conduit.Lzma.decompress: error: "String -> String -> String
forall a. [a] -> [a] -> [a]
++LzmaRet -> String
prettyRet LzmaRet
err
compress
:: (MonadIO m)
=> Maybe Int
-> ConduitM ByteString ByteString m ()
compress :: Maybe Int -> ConduitM ByteString ByteString m ()
compress level :: Maybe Int
level =
CompressParams -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
CompressParams -> ConduitM ByteString ByteString m ()
compressWith CompressParams
Lzma.defaultCompressParams { compressLevel :: CompressionLevel
Lzma.compressLevel = CompressionLevel
level' }
where
level' :: CompressionLevel
level' = case Maybe Int
level of
Nothing -> CompressionLevel
Lzma.CompressionLevel6
Just n :: Int
n -> Int -> CompressionLevel
forall a. Enum a => Int -> a
toEnum (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 9 Int
n))
compressWith
:: MonadIO m
=> Lzma.CompressParams
-> ConduitM ByteString ByteString m ()
compressWith :: CompressParams -> ConduitM ByteString ByteString m ()
compressWith parms :: CompressParams
parms = do
CompressStream IO
s <- IO (CompressStream IO)
-> ConduitT ByteString ByteString m (CompressStream IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (CompressParams -> IO (CompressStream IO)
Lzma.compressIO CompressParams
parms)
CompressStream IO -> ConduitM ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
CompressStream IO -> ConduitT ByteString ByteString m ()
go CompressStream IO
s
where
go :: CompressStream IO -> ConduitT ByteString ByteString m ()
go s :: CompressStream IO
s@(Lzma.CompressInputRequired _flush :: IO (CompressStream IO)
_flush more :: ByteString -> IO (CompressStream IO)
more) = do
Maybe ByteString
mx <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
case Maybe ByteString
mx of
Just x :: ByteString
x
| ByteString -> Bool
B.null ByteString
x -> CompressStream IO -> ConduitT ByteString ByteString m ()
go CompressStream IO
s
| Bool
otherwise -> IO (CompressStream IO)
-> ConduitT ByteString ByteString m (CompressStream IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO (CompressStream IO)
more ByteString
x) ConduitT ByteString ByteString m (CompressStream IO)
-> (CompressStream IO -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompressStream IO -> ConduitT ByteString ByteString m ()
go
Nothing -> IO (CompressStream IO)
-> ConduitT ByteString ByteString m (CompressStream IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO (CompressStream IO)
more ByteString
B.empty) ConduitT ByteString ByteString m (CompressStream IO)
-> (CompressStream IO -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompressStream IO -> ConduitT ByteString ByteString m ()
go
go (Lzma.CompressOutputAvailable output :: ByteString
output cont :: IO (CompressStream IO)
cont) = do
ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
output
IO (CompressStream IO)
-> ConduitT ByteString ByteString m (CompressStream IO)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (CompressStream IO)
cont ConduitT ByteString ByteString m (CompressStream IO)
-> (CompressStream IO -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompressStream IO -> ConduitT ByteString ByteString m ()
go
go Lzma.CompressStreamEnd = () -> ConduitT ByteString ByteString m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()