{-# 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 parms :: DecompressParams
parms input :: ByteString
input = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST (ByteString -> ST s ByteString
forall s. ByteString -> ST s ByteString
decompress' ByteString
input)
where
decompress' :: BSL.ByteString -> ST s BSL.ByteString
decompress' :: ByteString -> ST s ByteString
decompress' ibs0 :: ByteString
ibs0 = ByteString -> DecompressStream (ST s) -> ST s ByteString
forall (m :: * -> *).
MonadFail m =>
ByteString -> DecompressStream m -> m ByteString
loop ByteString
ibs0 (DecompressStream (ST s) -> ST s ByteString)
-> ST s (DecompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DecompressParams -> ST s (DecompressStream (ST s))
forall s. DecompressParams -> ST s (DecompressStream (ST s))
decompressST DecompressParams
parms
where
loop :: ByteString -> DecompressStream m -> m ByteString
loop BSL.Empty (DecompressStreamEnd rest :: ByteString
rest)
| ByteString -> Bool
BS.null ByteString
rest = ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BSL.Empty
| Bool
otherwise = String -> m ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Codec.Compression.Lzma.decompressWith: trailing data"
loop (BSL.Chunk _ _) (DecompressStreamEnd _) =
String -> m ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Codec.Compression.Lzma.decompressWith: trailing data"
loop _ (DecompressStreamError e :: LzmaRet
e) =
String -> m ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("Codec.Compression.Lzma.decompressWith: decoding error " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LzmaRet -> String
forall a. Show a => a -> String
show LzmaRet
e)
loop BSL.Empty (DecompressInputRequired supply :: ByteString -> m (DecompressStream m)
supply) =
ByteString -> DecompressStream m -> m ByteString
loop ByteString
BSL.Empty (DecompressStream m -> m ByteString)
-> m (DecompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (DecompressStream m)
supply ByteString
BS.empty
loop (BSL.Chunk c :: ByteString
c bs' :: ByteString
bs') (DecompressInputRequired supply :: ByteString -> m (DecompressStream m)
supply) =
ByteString -> DecompressStream m -> m ByteString
loop ByteString
bs' (DecompressStream m -> m ByteString)
-> m (DecompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (DecompressStream m)
supply ByteString
c
loop ibs :: ByteString
ibs (DecompressOutputAvailable oc :: ByteString
oc next :: m (DecompressStream m)
next) = do
ByteString
obs <- ByteString -> DecompressStream m -> m ByteString
loop ByteString
ibs (DecompressStream m -> m ByteString)
-> m (DecompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (DecompressStream m)
next
ByteString -> m ByteString
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 parms :: CompressParams
parms input :: ByteString
input = (forall s. ST s ByteString) -> ByteString
forall a. (forall s. ST s a) -> a
runST (ByteString -> ST s ByteString
forall s. ByteString -> ST s ByteString
compress' ByteString
input)
where
compress' :: BSL.ByteString -> ST s BSL.ByteString
compress' :: ByteString -> ST s ByteString
compress' ibs0 :: ByteString
ibs0 = ByteString -> CompressStream (ST s) -> ST s ByteString
forall (m :: * -> *).
MonadFail m =>
ByteString -> CompressStream m -> m ByteString
loop ByteString
ibs0 (CompressStream (ST s) -> ST s ByteString)
-> ST s (CompressStream (ST s)) -> ST s ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CompressParams -> ST s (CompressStream (ST s))
forall s. CompressParams -> ST s (CompressStream (ST s))
compressST CompressParams
parms
where
loop :: ByteString -> CompressStream m -> m ByteString
loop BSL.Empty CompressStreamEnd =
ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BSL.Empty
loop (BSL.Chunk _ _) CompressStreamEnd =
String -> m ByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Codec.Compression.Lzma.compressWith: the impossible happened"
loop BSL.Empty (CompressInputRequired _ supply :: ByteString -> m (CompressStream m)
supply) =
ByteString -> CompressStream m -> m ByteString
loop ByteString
BSL.Empty (CompressStream m -> m ByteString)
-> m (CompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (CompressStream m)
supply ByteString
BS.empty
loop (BSL.Chunk c :: ByteString
c bs' :: ByteString
bs') (CompressInputRequired _ supply :: ByteString -> m (CompressStream m)
supply) =
ByteString -> CompressStream m -> m ByteString
loop ByteString
bs' (CompressStream m -> m ByteString)
-> m (CompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> m (CompressStream m)
supply ByteString
c
loop ibs :: ByteString
ibs (CompressOutputAvailable oc :: ByteString
oc next :: m (CompressStream m)
next) = do
ByteString
obs <- ByteString -> CompressStream m -> m ByteString
loop ByteString
ibs (CompressStream m -> m ByteString)
-> m (CompressStream m) -> m ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (CompressStream m)
next
ByteString -> m ByteString
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 parms :: CompressParams
parms = (ST RealWorld (Either LzmaRet LzmaStream)
-> IO (Either LzmaRet LzmaStream)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Either LzmaRet LzmaStream)
-> IO (Either LzmaRet LzmaStream))
-> ST RealWorld (Either LzmaRet LzmaStream)
-> IO (Either LzmaRet LzmaStream)
forall a b. (a -> b) -> a -> b
$ CompressParams -> ST RealWorld (Either LzmaRet LzmaStream)
forall s. CompressParams -> ST s (Either LzmaRet LzmaStream)
newEncodeLzmaStream CompressParams
parms) IO (Either LzmaRet LzmaStream)
-> (Either LzmaRet LzmaStream -> IO (CompressStream IO))
-> IO (CompressStream IO)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LzmaRet -> IO (CompressStream IO))
-> (LzmaStream -> IO (CompressStream IO))
-> Either LzmaRet LzmaStream
-> IO (CompressStream IO)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either LzmaRet -> IO (CompressStream IO)
forall e a. Exception e => e -> IO a
throwIO LzmaStream -> IO (CompressStream IO)
go
where
bUFSIZ :: Int
bUFSIZ = 32752
go :: LzmaStream -> IO (CompressStream IO)
go :: LzmaStream -> IO (CompressStream IO)
go ls :: LzmaStream
ls = CompressStream IO -> IO (CompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream IO
inputRequired
where
inputRequired :: CompressStream IO
inputRequired = IO (CompressStream IO)
-> (ByteString -> IO (CompressStream IO)) -> CompressStream IO
forall (m :: * -> *).
m (CompressStream m)
-> (ByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired IO (CompressStream IO)
goFlush (IO (CompressStream IO)
-> (ByteString -> IO (CompressStream IO))
-> ByteString
-> IO (CompressStream IO)
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 chunk :: ByteString
chunk = do
(rc :: LzmaRet
rc, used :: Int
used, obuf :: ByteString
obuf) <- ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString))
-> ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST RealWorld (LzmaRet, Int, ByteString)
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
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "compressIO: input chunk not consumed"
IO (CompressStream IO)
-> (ByteString -> IO (CompressStream IO))
-> ByteString
-> IO (CompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (CompressStream IO -> IO (CompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream IO
inputRequired) ByteString -> IO (CompressStream IO)
goInput ByteString
chunk'
| Bool
otherwise -> CompressStream IO -> IO (CompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf
(IO (CompressStream IO)
-> (ByteString -> IO (CompressStream IO))
-> ByteString
-> IO (CompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (CompressStream IO -> IO (CompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream IO
inputRequired) ByteString -> IO (CompressStream IO)
goInput ByteString
chunk'))
_ -> LzmaRet -> IO (CompressStream IO)
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 (CompressStream IO -> IO (CompressStream IO)
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 IO (CompressStream IO)
forall (m :: * -> *). IO (CompressStream m)
retStreamEnd
goSync :: LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO)
goSync :: LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO)
goSync LzmaRun _ = String -> IO (CompressStream IO)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "goSync called with invalid argument"
goSync action :: LzmaAction
action next :: IO (CompressStream IO)
next = IO (CompressStream IO)
goSync'
where
goSync' :: IO (CompressStream IO)
goSync' = do
(rc :: LzmaRet
rc, 0, obuf :: ByteString
obuf) <- ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString))
-> ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST RealWorld (LzmaRet, Int, ByteString)
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
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> String -> IO (CompressStream IO)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("compressIO: empty output chunk during " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LzmaAction -> String
forall a. Show a => a -> String
show LzmaAction
action)
| Bool
otherwise -> CompressStream IO -> IO (CompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf IO (CompressStream IO)
goSync')
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> IO (CompressStream IO)
next
| Bool
otherwise -> CompressStream IO -> IO (CompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO (CompressStream IO) -> CompressStream IO
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf IO (CompressStream IO)
next)
_ -> LzmaRet -> IO (CompressStream IO)
forall e a. Exception e => e -> IO a
throwIO LzmaRet
rc
retStreamEnd :: IO (CompressStream m)
retStreamEnd = do
!() <- ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (LzmaStream -> ST RealWorld ()
forall s. LzmaStream -> ST s ()
endLzmaStream LzmaStream
ls)
CompressStream m -> IO (CompressStream m)
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream m
forall (m :: * -> *). CompressStream m
CompressStreamEnd
compressST :: CompressParams -> ST s (CompressStream (ST s))
compressST :: CompressParams -> ST s (CompressStream (ST s))
compressST parms :: CompressParams
parms = ST s (Either LzmaRet LzmaStream)
-> ST s (Either LzmaRet LzmaStream)
forall s a. ST s a -> ST s a
strictToLazyST (CompressParams -> ST s (Either LzmaRet LzmaStream)
forall s. CompressParams -> ST s (Either LzmaRet LzmaStream)
newEncodeLzmaStream CompressParams
parms) ST s (Either LzmaRet LzmaStream)
-> (Either LzmaRet LzmaStream -> ST s (CompressStream (ST s)))
-> ST s (CompressStream (ST s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(LzmaRet -> ST s (CompressStream (ST s)))
-> (LzmaStream -> ST s (CompressStream (ST s)))
-> Either LzmaRet LzmaStream
-> ST s (CompressStream (ST s))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either LzmaRet -> ST s (CompressStream (ST s))
forall a e. Exception e => e -> a
throw LzmaStream -> ST s (CompressStream (ST s))
forall (m :: * -> *) s.
Monad m =>
LzmaStream -> m (CompressStream (ST s))
go
where
bUFSIZ :: Int
bUFSIZ = 32752
go :: LzmaStream -> m (CompressStream (ST s))
go ls :: LzmaStream
ls = CompressStream (ST s) -> m (CompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream (ST s)
forall s. CompressStream (ST s)
inputRequired
where
inputRequired :: CompressStream (ST s)
inputRequired = ST s (CompressStream (ST s))
-> (ByteString -> ST s (CompressStream (ST s)))
-> CompressStream (ST s)
forall (m :: * -> *).
m (CompressStream m)
-> (ByteString -> m (CompressStream m)) -> CompressStream m
CompressInputRequired ST s (CompressStream (ST s))
forall s. ST s (CompressStream (ST s))
goFlush (ST s (CompressStream (ST s))
-> (ByteString -> ST s (CompressStream (ST s)))
-> ByteString
-> ST s (CompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk ST s (CompressStream (ST s))
forall s. ST s (CompressStream (ST s))
goFinish ByteString -> ST s (CompressStream (ST s))
forall s. ByteString -> ST s (CompressStream (ST s))
goInput)
goInput :: ByteString -> ST s (CompressStream (ST s))
goInput :: ByteString -> ST s (CompressStream (ST s))
goInput chunk :: ByteString
chunk = do
(rc :: LzmaRet
rc, used :: Int
used, obuf :: ByteString
obuf) <- ST s (LzmaRet, Int, ByteString) -> ST s (LzmaRet, Int, ByteString)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (LzmaRet, Int, ByteString)
-> ST s (LzmaRet, Int, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
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
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> do
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
String -> ST s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "compressST: input chunk not consumed"
ST s (CompressStream (ST s))
-> (ByteString -> ST s (CompressStream (ST s)))
-> ByteString
-> ST s (CompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream (ST s)
forall s. CompressStream (ST s)
inputRequired) ByteString -> ST s (CompressStream (ST s))
forall s. ByteString -> ST s (CompressStream (ST s))
goInput ByteString
chunk'
| Bool
otherwise -> CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf
(ST s (CompressStream (ST s))
-> (ByteString -> ST s (CompressStream (ST s)))
-> ByteString
-> ST s (CompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream (ST s)
forall s. CompressStream (ST s)
inputRequired) ByteString -> ST s (CompressStream (ST s))
forall s. ByteString -> ST s (CompressStream (ST s))
goInput ByteString
chunk'))
_ -> LzmaRet -> ST s (CompressStream (ST s))
forall a e. Exception e => e -> a
throw LzmaRet
rc
goFlush, goFinish :: ST s (CompressStream (ST s))
goFlush :: ST s (CompressStream (ST s))
goFlush = LzmaAction
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
forall s.
LzmaAction
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
goSync LzmaAction
LzmaSyncFlush (CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream (ST s)
forall s. CompressStream (ST s)
inputRequired)
goFinish :: ST s (CompressStream (ST s))
goFinish = LzmaAction
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
forall s.
LzmaAction
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
goSync LzmaAction
LzmaFinish ST s (CompressStream (ST s))
forall s (m :: * -> *). ST s (CompressStream m)
retStreamEnd
goSync :: LzmaAction -> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
goSync :: LzmaAction
-> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s))
goSync LzmaRun _ = String -> ST s (CompressStream (ST s))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "compressST: goSync called with invalid argument"
goSync action :: LzmaAction
action next :: ST s (CompressStream (ST s))
next = ST s (CompressStream (ST s))
goSync'
where
goSync' :: ST s (CompressStream (ST s))
goSync' = do
(rc :: LzmaRet
rc, 0, obuf :: ByteString
obuf) <- ST s (LzmaRet, Int, ByteString) -> ST s (LzmaRet, Int, ByteString)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (LzmaRet, Int, ByteString)
-> ST s (LzmaRet, Int, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
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
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> String -> ST s (CompressStream (ST s))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ("compressIO: empty output chunk during " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LzmaAction -> String
forall a. Show a => a -> String
show LzmaAction
action)
| Bool
otherwise -> CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf ST s (CompressStream (ST s))
goSync')
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> ST s (CompressStream (ST s))
next
| Bool
otherwise -> CompressStream (ST s) -> ST s (CompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ST s (CompressStream (ST s)) -> CompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (CompressStream m) -> CompressStream m
CompressOutputAvailable ByteString
obuf ST s (CompressStream (ST s))
next)
_ -> LzmaRet -> ST s (CompressStream (ST s))
forall a e. Exception e => e -> a
throw LzmaRet
rc
retStreamEnd :: ST s (CompressStream m)
retStreamEnd = do
!() <- ST s () -> ST s ()
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LzmaStream -> ST s ()
forall s. LzmaStream -> ST s ()
endLzmaStream LzmaStream
ls)
CompressStream m -> ST s (CompressStream m)
forall (m :: * -> *) a. Monad m => a -> m a
return CompressStream m
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 parms :: DecompressParams
parms = ST RealWorld (Either LzmaRet LzmaStream)
-> IO (Either LzmaRet LzmaStream)
forall a. ST RealWorld a -> IO a
stToIO (DecompressParams -> ST RealWorld (Either LzmaRet LzmaStream)
forall s. DecompressParams -> ST s (Either LzmaRet LzmaStream)
newDecodeLzmaStream DecompressParams
parms) IO (Either LzmaRet LzmaStream)
-> (Either LzmaRet LzmaStream -> IO (DecompressStream IO))
-> IO (DecompressStream IO)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (LzmaRet -> IO (DecompressStream IO))
-> (LzmaStream -> IO (DecompressStream IO))
-> Either LzmaRet LzmaStream
-> IO (DecompressStream IO)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> (LzmaRet -> DecompressStream IO)
-> LzmaRet
-> IO (DecompressStream IO)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LzmaRet -> DecompressStream IO
forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError) LzmaStream -> IO (DecompressStream IO)
go
where
bUFSIZ :: Int
bUFSIZ = 32752
go :: LzmaStream -> IO (DecompressStream IO)
go :: LzmaStream -> IO (DecompressStream IO)
go ls :: LzmaStream
ls = DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream IO
inputRequired
where
inputRequired :: DecompressStream IO
inputRequired = (ByteString -> IO (DecompressStream IO)) -> DecompressStream IO
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 chunk :: ByteString
chunk
| ByteString -> Bool
BS.null ByteString
chunk = IO (DecompressStream IO)
goFinish
| Bool
otherwise = do
(rc :: LzmaRet
rc, used :: Int
used, obuf :: ByteString
obuf) <- ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString))
-> ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST RealWorld (LzmaRet, Int, ByteString)
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
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "decompressIO: input chunk not consumed"
IO (DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO))
-> ByteString
-> IO (DecompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream IO
inputRequired) ByteString -> IO (DecompressStream IO)
goInput ByteString
chunk'
| Bool
otherwise -> DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf
(IO (DecompressStream IO)
-> (ByteString -> IO (DecompressStream IO))
-> ByteString
-> IO (DecompressStream IO)
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk IO (DecompressStream IO)
goDrain ByteString -> IO (DecompressStream IO)
goInput ByteString
chunk'))
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> ByteString -> IO (DecompressStream IO)
forall (m :: * -> *). ByteString -> IO (DecompressStream m)
retStreamEnd ByteString
chunk'
| Bool
otherwise -> DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf
(ByteString -> IO (DecompressStream IO)
forall (m :: * -> *). ByteString -> IO (DecompressStream m)
retStreamEnd ByteString
chunk'))
_ -> DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (LzmaRet -> DecompressStream IO
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 (DecompressStream IO -> IO (DecompressStream IO)
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 (DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream IO -> IO (DecompressStream IO))
-> DecompressStream IO -> IO (DecompressStream IO)
forall a b. (a -> b) -> a -> b
$ LzmaRet -> DecompressStream IO
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 action :: LzmaAction
action next :: IO (DecompressStream IO)
next = IO (DecompressStream IO)
goSync'
where
goSync' :: IO (DecompressStream IO)
goSync' = do
(rc :: LzmaRet
rc, 0, obuf :: ByteString
obuf) <- ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString))
-> ST RealWorld (LzmaRet, Int, ByteString)
-> IO (LzmaRet, Int, ByteString)
forall a b. (a -> b) -> a -> b
$ LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST RealWorld (LzmaRet, Int, ByteString)
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
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> IO (DecompressStream IO)
next
| Bool
otherwise -> DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf IO (DecompressStream IO)
goSync')
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> IO (DecompressStream IO)
forall (m :: * -> *). IO (DecompressStream m)
eof0
| Bool
otherwise -> DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO (DecompressStream IO) -> DecompressStream IO
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf IO (DecompressStream IO)
forall (m :: * -> *). IO (DecompressStream m)
eof0)
_ -> DecompressStream IO -> IO (DecompressStream IO)
forall (m :: * -> *) a. Monad m => a -> m a
return (LzmaRet -> DecompressStream IO
forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
rc)
eof0 :: IO (DecompressStream m)
eof0 = ByteString -> IO (DecompressStream m)
forall (m :: * -> *). ByteString -> IO (DecompressStream m)
retStreamEnd ByteString
BS.empty
retStreamEnd :: ByteString -> IO (DecompressStream m)
retStreamEnd chunk' :: ByteString
chunk' = do
!() <- ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (LzmaStream -> ST RealWorld ()
forall s. LzmaStream -> ST s ()
endLzmaStream LzmaStream
ls)
DecompressStream m -> IO (DecompressStream m)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> DecompressStream m
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
chunk')
decompressST :: DecompressParams -> ST s (DecompressStream (ST s))
decompressST :: DecompressParams -> ST s (DecompressStream (ST s))
decompressST parms :: DecompressParams
parms = ST s (Either LzmaRet LzmaStream)
-> ST s (Either LzmaRet LzmaStream)
forall s a. ST s a -> ST s a
strictToLazyST (DecompressParams -> ST s (Either LzmaRet LzmaStream)
forall s. DecompressParams -> ST s (Either LzmaRet LzmaStream)
newDecodeLzmaStream DecompressParams
parms) ST s (Either LzmaRet LzmaStream)
-> (Either LzmaRet LzmaStream -> ST s (DecompressStream (ST s)))
-> ST s (DecompressStream (ST s))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(LzmaRet -> ST s (DecompressStream (ST s)))
-> (LzmaStream -> ST s (DecompressStream (ST s)))
-> Either LzmaRet LzmaStream
-> ST s (DecompressStream (ST s))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> (LzmaRet -> DecompressStream (ST s))
-> LzmaRet
-> ST s (DecompressStream (ST s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LzmaRet -> DecompressStream (ST s)
forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError) LzmaStream -> ST s (DecompressStream (ST s))
forall s. LzmaStream -> ST s (DecompressStream (ST s))
go
where
bUFSIZ :: Int
bUFSIZ = 32752
go :: LzmaStream -> ST s (DecompressStream (ST s))
go :: LzmaStream -> ST s (DecompressStream (ST s))
go ls :: LzmaStream
ls = DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream (ST s)
forall s. DecompressStream (ST s)
inputRequired
where
inputRequired :: DecompressStream (ST s)
inputRequired = (ByteString -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s)
forall (m :: * -> *).
(ByteString -> m (DecompressStream m)) -> DecompressStream m
DecompressInputRequired ByteString -> ST s (DecompressStream (ST s))
forall s. ByteString -> ST s (DecompressStream (ST s))
goInput
goInput :: ByteString -> ST s (DecompressStream (ST s))
goInput :: ByteString -> ST s (DecompressStream (ST s))
goInput chunk :: ByteString
chunk
| ByteString -> Bool
BS.null ByteString
chunk = ST s (DecompressStream (ST s))
forall s. ST s (DecompressStream (ST s))
goFinish
| Bool
otherwise = do
(rc :: LzmaRet
rc, used :: Int
used, obuf :: ByteString
obuf) <- ST s (LzmaRet, Int, ByteString) -> ST s (LzmaRet, Int, ByteString)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (LzmaRet, Int, ByteString)
-> ST s (LzmaRet, Int, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
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
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> do
Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
used Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
String -> ST s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "decompressST: input chunk not consumed"
ST s (DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> ByteString
-> ST s (DecompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream (ST s)
forall s. DecompressStream (ST s)
inputRequired) ByteString -> ST s (DecompressStream (ST s))
forall s. ByteString -> ST s (DecompressStream (ST s))
goInput ByteString
chunk'
| Bool
otherwise -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf
(ST s (DecompressStream (ST s))
-> (ByteString -> ST s (DecompressStream (ST s)))
-> ByteString
-> ST s (DecompressStream (ST s))
forall t. t -> (ByteString -> t) -> ByteString -> t
withChunk ST s (DecompressStream (ST s))
forall s. ST s (DecompressStream (ST s))
goDrain ByteString -> ST s (DecompressStream (ST s))
forall s. ByteString -> ST s (DecompressStream (ST s))
goInput ByteString
chunk'))
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> ByteString -> ST s (DecompressStream (ST s))
forall s (m :: * -> *). ByteString -> ST s (DecompressStream m)
retStreamEnd ByteString
chunk'
| Bool
otherwise -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf
(ByteString -> ST s (DecompressStream (ST s))
forall s (m :: * -> *). ByteString -> ST s (DecompressStream m)
retStreamEnd ByteString
chunk'))
_ -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (LzmaRet -> DecompressStream (ST s)
forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
rc)
goDrain, goFinish :: ST s (DecompressStream (ST s))
goDrain :: ST s (DecompressStream (ST s))
goDrain = LzmaAction
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
forall s.
LzmaAction
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
goSync LzmaAction
LzmaRun (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return DecompressStream (ST s)
forall s. DecompressStream (ST s)
inputRequired)
goFinish :: ST s (DecompressStream (ST s))
goFinish = LzmaAction
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
forall s.
LzmaAction
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
goSync LzmaAction
LzmaFinish (DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (DecompressStream (ST s) -> ST s (DecompressStream (ST s)))
-> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall a b. (a -> b) -> a -> b
$ LzmaRet -> DecompressStream (ST s)
forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
LzmaRetOK)
goSync :: LzmaAction -> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
goSync :: LzmaAction
-> ST s (DecompressStream (ST s)) -> ST s (DecompressStream (ST s))
goSync action :: LzmaAction
action next :: ST s (DecompressStream (ST s))
next = ST s (DecompressStream (ST s))
goSync'
where
goSync' :: ST s (DecompressStream (ST s))
goSync' = do
(rc :: LzmaRet
rc, 0, obuf :: ByteString
obuf) <- ST s (LzmaRet, Int, ByteString) -> ST s (LzmaRet, Int, ByteString)
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s ()
-> ST s (LzmaRet, Int, ByteString)
-> ST s (LzmaRet, Int, ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
LzmaStream
-> ByteString
-> LzmaAction
-> Int
-> ST s (LzmaRet, Int, ByteString)
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
LzmaRetOK
| ByteString -> Bool
BS.null ByteString
obuf -> ST s (DecompressStream (ST s))
next
| Bool
otherwise -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf ST s (DecompressStream (ST s))
goSync')
LzmaRetStreamEnd
| ByteString -> Bool
BS.null ByteString
obuf -> ST s (DecompressStream (ST s))
forall s (m :: * -> *). ST s (DecompressStream m)
eof0
| Bool
otherwise -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
-> ST s (DecompressStream (ST s)) -> DecompressStream (ST s)
forall (m :: * -> *).
ByteString -> m (DecompressStream m) -> DecompressStream m
DecompressOutputAvailable ByteString
obuf ST s (DecompressStream (ST s))
forall s (m :: * -> *). ST s (DecompressStream m)
eof0)
_ -> DecompressStream (ST s) -> ST s (DecompressStream (ST s))
forall (m :: * -> *) a. Monad m => a -> m a
return (LzmaRet -> DecompressStream (ST s)
forall (m :: * -> *). LzmaRet -> DecompressStream m
DecompressStreamError LzmaRet
rc)
eof0 :: ST s (DecompressStream m)
eof0 = ByteString -> ST s (DecompressStream m)
forall s (m :: * -> *). ByteString -> ST s (DecompressStream m)
retStreamEnd ByteString
BS.empty
retStreamEnd :: ByteString -> ST s (DecompressStream m)
retStreamEnd chunk' :: ByteString
chunk' = do
!() <- ST s () -> ST s ()
forall s a. ST s a -> ST s a
strictToLazyST (ST s ()
forall s. ST s ()
noDuplicateST ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> LzmaStream -> ST s ()
forall s. LzmaStream -> ST s ()
endLzmaStream LzmaStream
ls)
DecompressStream m -> ST s (DecompressStream m)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> DecompressStream m
forall (m :: * -> *). ByteString -> DecompressStream m
DecompressStreamEnd ByteString
chunk')
withChunk :: t -> (ByteString -> t) -> ByteString -> t
withChunk :: t -> (ByteString -> t) -> ByteString -> t
withChunk emptyChunk :: t
emptyChunk nemptyChunk :: ByteString -> t
nemptyChunk chunk :: ByteString
chunk
| ByteString -> Bool
BS.null ByteString
chunk = t
emptyChunk
| Bool
otherwise = ByteString -> t
nemptyChunk ByteString
chunk
noDuplicateST :: ST.Strict.ST s ()
noDuplicateST :: ST s ()
noDuplicateST = IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST IO ()
noDuplicate