{-# LANGUAGE BangPatterns #-}
module Codec.Compression.Lzma
(
compress
, decompress
, compressWith
, decompressWith
, CompressStream(..)
, compressIO
, compressST
, DecompressStream(..)
, decompressIO
, decompressST
, LzmaRet(..)
, defaultCompressParams
, CompressParams
, compressIntegrityCheck
, compressLevel
, compressLevelExtreme
, IntegrityCheck(..)
, CompressionLevel(..)
, defaultDecompressParams
, DecompressParams
, decompressTellNoCheck
, decompressTellUnsupportedCheck
, decompressTellAnyCheck
, decompressConcatenated
, decompressAutoDecoder
, decompressMemLimit
) where
import Control.Exception
import Control.Monad
import Control.Monad.ST (stToIO)
import Control.Monad.ST.Lazy (ST, runST, strictToLazyST)
import qualified Control.Monad.ST.Strict as ST.Strict (ST)
import Control.Monad.ST.Unsafe (unsafeIOToST)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Internal as BSL
import GHC.IO (noDuplicate)
import LibLzma
decompress :: BSL.ByteString -> BSL.ByteString
decompress :: ByteString -> ByteString
decompress = DecompressParams -> ByteString -> ByteString
decompressWith DecompressParams
defaultDecompressParams
decompressWith :: DecompressParams -> BSL.ByteString -> BSL.ByteString
decompressWith :: DecompressParams -> ByteString -> ByteString
decompressWith DecompressParams
parms ByteString
input = forall a. (forall s. ST s a) -> a
runST (forall s. ByteString -> ST s ByteString
decompress' ByteString
input)
where
decompress' :: BSL.ByteString -> ST s BSL.ByteString
decompress' :: forall s. ByteString -> ST s ByteString
decompress' ByteString
ibs0 = forall {m :: * -> *}.
Monad m =>
ByteString -> DecompressStream m -> m ByteString
loop ByteString
ibs0 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. DecompressParams -> ST s (DecompressStream (ST s))
decompressST DecompressParams
parms
where
loop :: ByteString -> DecompressStream m -> m ByteString
loop ByteString
BSL.Empty (DecompressStreamEnd ByteString
rest)
| ByteString -> Bool
BS.null ByteString
rest = forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BSL.Empty
| Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"Codec.Compression.Lzma.decompressWith: trailing data"
loop (BSL.Chunk ByteString
_ ByteString
_) (DecompressStreamEnd ByteString
_) =
forall a. HasCallStack => [Char] -> a
error [Char]
"Codec.Compression.Lzma.decompressWith: trailing data"
loop ByteString
_ (DecompressStreamError LzmaRet
e) =
forall a. HasCallStack => [Char] -> a
error ([Char]
"Codec.Compression.Lzma.decompressWith: decoding error " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show LzmaRet
e)
loop ByteString
BSL.Empty (DecompressInputRequired ByteString -> m (DecompressStream m)
supply) =
ByteString -> DecompressStream m -> m ByteString
loop ByteString
BSL.Empty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (DecompressStream m)
supply ByteString
BS.empty
loop (BSL.Chunk ByteString
c ByteString
bs') (DecompressInputRequired ByteString -> m (DecompressStream m)
supply) =
ByteString -> DecompressStream m -> m ByteString
loop ByteString
bs' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (DecompressStream m)
supply ByteString
c
loop ByteString
ibs (DecompressOutputAvailable ByteString
oc m (DecompressStream m)
next) = do
ByteString
obs <- ByteString -> DecompressStream m -> m ByteString
loop ByteString
ibs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (DecompressStream m)
next
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
BSL.chunk ByteString
oc ByteString
obs)
{-# NOINLINE decompressWith #-}
compress :: BSL.ByteString -> BSL.ByteString
compress :: ByteString -> ByteString
compress = CompressParams -> ByteString -> ByteString
compressWith CompressParams
defaultCompressParams
compressWith :: CompressParams -> BSL.ByteString -> BSL.ByteString
compressWith :: CompressParams -> ByteString -> ByteString
compressWith CompressParams
parms ByteString
input = forall a. (forall s. ST s a) -> a
runST (forall s. ByteString -> ST s ByteString
compress' ByteString
input)
where
compress' :: BSL.ByteString -> ST s BSL.ByteString
compress' :: forall s. ByteString -> ST s ByteString
compress' ByteString
ibs0 = forall {m :: * -> *}.
Monad m =>
ByteString -> CompressStream m -> m ByteString
loop ByteString
ibs0 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s. CompressParams -> ST s (CompressStream (ST s))
compressST CompressParams
parms
where
loop :: ByteString -> CompressStream m -> m ByteString
loop ByteString
BSL.Empty CompressStream m
CompressStreamEnd =
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BSL.Empty
loop (BSL.Chunk ByteString
_ ByteString
_) CompressStream m
CompressStreamEnd =
forall a. HasCallStack => [Char] -> a
error [Char]
"Codec.Compression.Lzma.compressWith: the impossible happened"
loop ByteString
BSL.Empty (CompressInputRequired m (CompressStream m)
_ ByteString -> m (CompressStream m)
supply) =
ByteString -> CompressStream m -> m ByteString
loop ByteString
BSL.Empty forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (CompressStream m)
supply ByteString
BS.empty
loop (BSL.Chunk ByteString
c ByteString
bs') (CompressInputRequired m (CompressStream m)
_ ByteString -> m (CompressStream m)
supply) =
ByteString -> CompressStream m -> m ByteString
loop ByteString
bs' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (CompressStream m)
supply ByteString
c
loop ByteString
ibs (CompressOutputAvailable ByteString
oc m (CompressStream m)
next) = do
ByteString
obs <- ByteString -> CompressStream m -> m ByteString
loop ByteString
ibs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (CompressStream m)
next
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString -> ByteString
BSL.chunk ByteString
oc ByteString
obs)
{-# NOINLINE compressWith #-}
data CompressStream m =
CompressInputRequired (m (CompressStream m))
(ByteString -> m (CompressStream m))
| CompressOutputAvailable !ByteString (m (CompressStream m))
| CompressStreamEnd
compressIO :: CompressParams -> IO (CompressStream IO)
compressIO :: CompressParams -> IO (CompressStream IO)
compressIO CompressParams
parms = (forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall s. CompressParams -> ST s (Either LzmaRet LzmaStream)
newEncodeLzmaStream CompressParams
parms) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e a. Exception e => e -> IO a
throwIO LzmaStream -> IO (CompressStream IO)
go
where
bUFSIZ :: Int
bUFSIZ = Int
32752
go :: LzmaStream -> IO (CompressStream IO)
go :: LzmaStream -> IO (CompressStream IO)
go LzmaStream
ls = forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream IO
inputRequired
where
inputRequired :: CompressStream IO
inputRequired = forall (m :: * -> *).
m (CompressStream m)
-> (ByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired IO (CompressStream IO)
goFlush (forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk IO (CompressStream IO)
goFinish ByteString -> IO (CompressStream IO)
goInput)
goInput :: ByteString -> IO (CompressStream IO)
goInput :: ByteString -> IO (CompressStream IO)
goInput ByteString
chunk = do
(LzmaRet
rc, Int
used, ByteString
obuf) <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall s.
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream LzmaStream
ls ByteString
chunk LzmaAction
LzmaRun Int
bUFSIZ
let chunk' :: ByteString
chunk' = Int -> ByteString -> ByteString
BS.drop Int
used ByteString
chunk
case LzmaRet
rc of
LzmaRet
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"compressIO: input chunk not consumed"
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream IO
inputRequired) ByteString -> IO (CompressStream IO)
goInput ByteString
chunk'
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf
(forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream IO
inputRequired) ByteString -> IO (CompressStream IO)
goInput ByteString
chunk'))
LzmaRet
_ -> forall e a. Exception e => e -> IO a
throwIO LzmaRet
rc
goFlush, goFinish :: IO (CompressStream IO)
goFlush :: IO (CompressStream IO)
goFlush = LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO)
goSync LzmaAction
LzmaSyncFlush (forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream IO
inputRequired)
goFinish :: IO (CompressStream IO)
goFinish = LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO)
goSync LzmaAction
LzmaFinish forall {m :: * -> *}. IO (CompressStream m)
retStreamEnd
goSync :: LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO)
goSync :: LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO)
goSync LzmaAction
LzmaRun IO (CompressStream IO)
_ = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"goSync called with invalid argument"
goSync LzmaAction
action IO (CompressStream IO)
next = IO (CompressStream IO)
goSync'
where
goSync' :: IO (CompressStream IO)
goSync' = do
(LzmaRet
rc, Int
0, ByteString
obuf) <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall s.
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream LzmaStream
ls ByteString
BS.empty LzmaAction
action Int
bUFSIZ
case LzmaRet
rc of
LzmaRet
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"compressIO: empty output chunk during " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show LzmaAction
action)
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf IO (CompressStream IO)
goSync')
LzmaRet
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> IO (CompressStream IO)
next
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf IO (CompressStream IO)
next)
LzmaRet
_ -> forall e a. Exception e => e -> IO a
throwIO LzmaRet
rc
retStreamEnd :: IO (CompressStream m)
retStreamEnd = do
!() <- forall a. ST RealWorld a -> IO a
stToIO (forall s. LzmaStream -> ST s ()
endLzmaStream LzmaStream
ls)
forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *). CompressStream m
CompressStreamEnd
compressST :: CompressParams -> ST s (CompressStream (ST s))
compressST :: forall s. CompressParams -> ST s (CompressStream (ST s))
compressST CompressParams
parms = forall s a. ST s a -> ST s a
strictToLazyST (forall s. CompressParams -> ST s (Either LzmaRet LzmaStream)
newEncodeLzmaStream CompressParams
parms) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall {m :: * -> *} {s}.
Monad m =>
LzmaStream -> m (CompressStream (ST s))
go
where
bUFSIZ :: Int
bUFSIZ = Int
32752
go :: LzmaStream -> m (CompressStream (ST s))
go LzmaStream
ls = forall (m :: * -> *) a. Monad m => a -> m a
return forall {s}. CompressStream (ST s)
inputRequired
where
inputRequired :: CompressStream (ST s)
inputRequired = forall (m :: * -> *).
m (CompressStream m)
-> (ByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired forall s. ST s (CompressStream (ST s))
goFlush (forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk forall s. ST s (CompressStream (ST s))
goFinish forall s. ByteString -> ST s (CompressStream (ST s))
goInput)
goInput :: ByteString -> ST s (CompressStream (ST s))
goInput :: forall s. ByteString -> ST s (CompressStream (ST s))
goInput ByteString
chunk = do
(LzmaRet
rc, Int
used, ByteString
obuf) <- forall s a. ST s a -> ST s a
strictToLazyST (forall s. ST s ()
noDuplicateST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall s.
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream LzmaStream
ls ByteString
chunk LzmaAction
LzmaRun Int
bUFSIZ)
let chunk' :: ByteString
chunk' = Int -> ByteString -> ByteString
BS.drop Int
used ByteString
chunk
case LzmaRet
rc of
LzmaRet
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error [Char]
"compressST: input chunk not consumed"
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (forall (m :: * -> *) a. Monad m => a -> m a
return forall {s}. CompressStream (ST s)
inputRequired) forall s. ByteString -> ST s (CompressStream (ST s))
goInput ByteString
chunk'
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf
(forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (forall (m :: * -> *) a. Monad m => a -> m a
return forall {s}. CompressStream (ST s)
inputRequired) forall s. ByteString -> ST s (CompressStream (ST s))
goInput ByteString
chunk'))
LzmaRet
_ -> forall a e. Exception e => e -> a
throw LzmaRet
rc
goFlush, goFinish :: ST s (CompressStream (ST s))
goFlush :: forall s. ST s (CompressStream (ST s))
goFlush = forall s.
LzmaAction
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
goSync LzmaAction
LzmaSyncFlush (forall (m :: * -> *) a. Monad m => a -> m a
return forall {s}. CompressStream (ST s)
inputRequired)
goFinish :: forall s. ST s (CompressStream (ST s))
goFinish = forall s.
LzmaAction
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
goSync LzmaAction
LzmaFinish forall {s} {m :: * -> *}. ST s (CompressStream m)
retStreamEnd
goSync :: LzmaAction -> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
goSync :: forall s.
LzmaAction
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
goSync LzmaAction
LzmaRun ST s (CompressStream (ST s))
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"compressST: goSync called with invalid argument"
goSync LzmaAction
action ST s (CompressStream (ST s))
next = ST s (CompressStream (ST s))
goSync'
where
goSync' :: ST s (CompressStream (ST s))
goSync' = do
(LzmaRet
rc, Int
n, ByteString
obuf) <- forall s a. ST s a -> ST s a
strictToLazyST (forall s. ST s ()
noDuplicateST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall s.
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream LzmaStream
ls ByteString
BS.empty LzmaAction
action Int
bUFSIZ)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"compressST: n was not zero"
case LzmaRet
rc of
LzmaRet
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> forall a. HasCallStack => [Char] -> a
error ([Char]
"compressIO: empty output chunk during " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show LzmaAction
action)
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf ST s (CompressStream (ST s))
goSync')
LzmaRet
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> ST s (CompressStream (ST s))
next
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf ST s (CompressStream (ST s))
next)
LzmaRet
_ -> forall a e. Exception e => e -> a
throw LzmaRet
rc
retStreamEnd :: ST s (CompressStream m)
retStreamEnd = do
!() <- forall s a. ST s a -> ST s a
strictToLazyST (forall s. ST s ()
noDuplicateST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. LzmaStream -> ST s ()
endLzmaStream LzmaStream
ls)
forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *). CompressStream m
CompressStreamEnd
data DecompressStream m =
DecompressInputRequired (ByteString -> m (DecompressStream m))
| DecompressOutputAvailable !ByteString (m (DecompressStream m))
| DecompressStreamEnd ByteString
| DecompressStreamError !LzmaRet
decompressIO :: DecompressParams -> IO (DecompressStream IO)
decompressIO :: DecompressParams -> IO (DecompressStream IO)
decompressIO DecompressParams
parms = forall a. ST RealWorld a -> IO a
stToIO (forall s. DecompressParams -> ST s (Either LzmaRet LzmaStream)
newDecodeLzmaStream DecompressParams
parms) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError) LzmaStream -> IO (DecompressStream IO)
go
where
bUFSIZ :: Int
bUFSIZ = Int
32752
go :: LzmaStream -> IO (DecompressStream IO)
go :: LzmaStream -> IO (DecompressStream IO)
go LzmaStream
ls = forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream IO
inputRequired
where
inputRequired :: DecompressStream IO
inputRequired = forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ByteString -> IO (DecompressStream IO)
goInput
goInput :: ByteString -> IO (DecompressStream IO)
goInput :: ByteString -> IO (DecompressStream IO)
goInput ByteString
chunk
| ByteString -> Bool
BS.null ByteString
chunk = IO (DecompressStream IO)
goFinish
| Bool
otherwise = do
(LzmaRet
rc, Int
used, ByteString
obuf) <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall s.
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream LzmaStream
ls ByteString
chunk LzmaAction
LzmaRun Int
bUFSIZ
let chunk' :: ByteString
chunk' = Int -> ByteString -> ByteString
BS.drop Int
used ByteString
chunk
case LzmaRet
rc of
LzmaRet
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"decompressIO: input chunk not consumed"
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream IO
inputRequired) ByteString -> IO (DecompressStream IO)
goInput ByteString
chunk'
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf
(forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk IO (DecompressStream IO)
goDrain ByteString -> IO (DecompressStream IO)
goInput ByteString
chunk'))
LzmaRet
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> forall {m :: * -> *}. ByteString -> IO (DecompressStream m)
retStreamEnd ByteString
chunk'
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf
(forall {m :: * -> *}. ByteString -> IO (DecompressStream m)
retStreamEnd ByteString
chunk'))
LzmaRet
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
rc)
goDrain, goFinish :: IO (DecompressStream IO)
goDrain :: IO (DecompressStream IO)
goDrain = LzmaAction -> IO (DecompressStream IO) -> IO (DecompressStream IO)
goSync LzmaAction
LzmaRun (forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream IO
inputRequired)
goFinish :: IO (DecompressStream IO)
goFinish = LzmaAction -> IO (DecompressStream IO) -> IO (DecompressStream IO)
goSync LzmaAction
LzmaFinish (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
LzmaRetOK)
goSync :: LzmaAction -> IO (DecompressStream IO) -> IO (DecompressStream IO)
goSync :: LzmaAction -> IO (DecompressStream IO) -> IO (DecompressStream IO)
goSync LzmaAction
action IO (DecompressStream IO)
next = IO (DecompressStream IO)
goSync'
where
goSync' :: IO (DecompressStream IO)
goSync' = do
(LzmaRet
rc, Int
0, ByteString
obuf) <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall s.
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream LzmaStream
ls ByteString
BS.empty LzmaAction
action Int
bUFSIZ
case LzmaRet
rc of
LzmaRet
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> IO (DecompressStream IO)
next
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf IO (DecompressStream IO)
goSync')
LzmaRet
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> forall {m :: * -> *}. IO (DecompressStream m)
eof0
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf forall {m :: * -> *}. IO (DecompressStream m)
eof0)
LzmaRet
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
rc)
eof0 :: IO (DecompressStream m)
eof0 = forall {m :: * -> *}. ByteString -> IO (DecompressStream m)
retStreamEnd ByteString
BS.empty
retStreamEnd :: ByteString -> IO (DecompressStream m)
retStreamEnd ByteString
chunk' = do
!() <- forall a. ST RealWorld a -> IO a
stToIO (forall s. LzmaStream -> ST s ()
endLzmaStream LzmaStream
ls)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
chunk')
decompressST :: DecompressParams -> ST s (DecompressStream (ST s))
decompressST :: forall s. DecompressParams -> ST s (DecompressStream (ST s))
decompressST DecompressParams
parms = forall s a. ST s a -> ST s a
strictToLazyST (forall s. DecompressParams -> ST s (Either LzmaRet LzmaStream)
newDecodeLzmaStream DecompressParams
parms) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError) forall s. LzmaStream -> ST s (DecompressStream (ST s))
go
where
bUFSIZ :: Int
bUFSIZ = Int
32752
go :: LzmaStream -> ST s (DecompressStream (ST s))
go :: forall s. LzmaStream -> ST s (DecompressStream (ST s))
go LzmaStream
ls = forall (m :: * -> *) a. Monad m => a -> m a
return forall {s}. DecompressStream (ST s)
inputRequired
where
inputRequired :: DecompressStream (ST s)
inputRequired = forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired forall s. ByteString -> ST s (DecompressStream (ST s))
goInput
goInput :: ByteString -> ST s (DecompressStream (ST s))
goInput :: forall s. ByteString -> ST s (DecompressStream (ST s))
goInput ByteString
chunk
| ByteString -> Bool
BS.null ByteString
chunk = forall s. ST s (DecompressStream (ST s))
goFinish
| Bool
otherwise = do
(LzmaRet
rc, Int
used, ByteString
obuf) <- forall s a. ST s a -> ST s a
strictToLazyST (forall s. ST s ()
noDuplicateST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall s.
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream LzmaStream
ls ByteString
chunk LzmaAction
LzmaRun Int
bUFSIZ)
let chunk' :: ByteString
chunk' = Int -> ByteString -> ByteString
BS.drop Int
used ByteString
chunk
case LzmaRet
rc of
LzmaRet
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => [Char] -> a
error [Char]
"decompressST: input chunk not consumed"
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (forall (m :: * -> *) a. Monad m => a -> m a
return forall {s}. DecompressStream (ST s)
inputRequired) forall s. ByteString -> ST s (DecompressStream (ST s))
goInput ByteString
chunk'
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf
(forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk forall s. ST s (DecompressStream (ST s))
goDrain forall s. ByteString -> ST s (DecompressStream (ST s))
goInput ByteString
chunk'))
LzmaRet
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> forall {s} {m :: * -> *}. ByteString -> ST s (DecompressStream m)
retStreamEnd ByteString
chunk'
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf
(forall {s} {m :: * -> *}. ByteString -> ST s (DecompressStream m)
retStreamEnd ByteString
chunk'))
LzmaRet
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
rc)
goDrain, goFinish :: ST s (DecompressStream (ST s))
goDrain :: forall s. ST s (DecompressStream (ST s))
goDrain = forall s.
LzmaAction
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
goSync LzmaAction
LzmaRun (forall (m :: * -> *) a. Monad m => a -> m a
return forall {s}. DecompressStream (ST s)
inputRequired)
goFinish :: forall s. ST s (DecompressStream (ST s))
goFinish = forall s.
LzmaAction
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
goSync LzmaAction
LzmaFinish (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
LzmaRetOK)
goSync :: LzmaAction -> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
goSync :: forall s.
LzmaAction
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
goSync LzmaAction
action ST s (DecompressStream (ST s))
next = ST s (DecompressStream (ST s))
goSync'
where
goSync' :: ST s (DecompressStream (ST s))
goSync' = do
(LzmaRet
rc, Int
n, ByteString
obuf) <- forall s a. ST s a -> ST s a
strictToLazyST (forall s. ST s ()
noDuplicateST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall s.
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
runLzmaStream LzmaStream
ls ByteString
BS.empty LzmaAction
action Int
bUFSIZ)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"decompressST: n was not zero"
case LzmaRet
rc of
LzmaRet
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> ST s (DecompressStream (ST s))
next
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf ST s (DecompressStream (ST s))
goSync')
LzmaRet
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> forall {s} {m :: * -> *}. ST s (DecompressStream m)
eof0
| Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf forall {s} {m :: * -> *}. ST s (DecompressStream m)
eof0)
LzmaRet
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
rc)
eof0 :: ST s (DecompressStream m)
eof0 = forall {s} {m :: * -> *}. ByteString -> ST s (DecompressStream m)
retStreamEnd ByteString
BS.empty
retStreamEnd :: ByteString -> ST s (DecompressStream m)
retStreamEnd ByteString
chunk' = do
!() <- forall s a. ST s a -> ST s a
strictToLazyST (forall s. ST s ()
noDuplicateST forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall s. LzmaStream -> ST s ()
endLzmaStream LzmaStream
ls)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
chunk')
withChunk :: t -> (ByteString -> t) -> ByteString -> t
withChunk :: forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk t
emptyChunk ByteString -> t
nemptyChunk ByteString
chunk
| ByteString -> Bool
BS.null ByteString
chunk = t
emptyChunk
| Bool
otherwise = ByteString -> t
nemptyChunk ByteString
chunk
noDuplicateST :: ST.Strict.ST s ()
noDuplicateST :: forall s. ST s ()
noDuplicateST = forall a s. IO a -> ST s a
unsafeIOToST IO ()
noDuplicate