{-# LANGUAGE BangPatterns #-}

-- |
-- Module      : Codec.Compression.Lzma
-- Copyright   : © 2015 Herbert Valerio Riedel
-- License     : BSD3
--
-- Maintainer  : hvr@gnu.org
-- Stability   : experimental
--
-- Compression and decompression of data streams in the lzma/xz format
--
-- See also the XZ Utils home page: <http://tukaani.org/xz/>
module Codec.Compression.Lzma
    ( -- * Simple (de)compression
      compress
    , decompress

      -- * Extended API with control over parameters
    , compressWith
    , decompressWith

      -- * Monadic incremental (de)compression API
      --
      -- | See <http://hackage.haskell.org/package/zlib-0.6.1.1/docs/Codec-Compression-Zlib-Internal.html#g:2 zlib's incremental API documentation> for more information.

      -- ** Compression
    , CompressStream(..)
    , compressIO
    , compressST

      -- ** Decompression
    , DecompressStream(..)
    , decompressIO
    , decompressST
    , LzmaRet(..)

      -- * Parameters
      -- ** Compression parameters
    , defaultCompressParams

    , CompressParams
    , compressIntegrityCheck
    , compressLevel
    , compressLevelExtreme

    , IntegrityCheck(..)
    , CompressionLevel(..)

      -- ** Decompression parameters
    , 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 lazy 'ByteString' from the @.xz@ format
decompress :: BSL.ByteString -> BSL.ByteString
decompress :: ByteString -> ByteString
decompress = DecompressParams -> ByteString -> ByteString
decompressWith DecompressParams
defaultDecompressParams

-- | Like 'decompress' but with the ability to specify various decompression
-- parameters. Typical usage:
--
-- > decompressWith defaultDecompressParams { decompress... = ... }
decompressWith :: DecompressParams -> BSL.ByteString -> BSL.ByteString
decompressWith :: DecompressParams -> ByteString -> ByteString
decompressWith DecompressParams
parms 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' ByteString
ibs0 = ByteString -> DecompressStream (ST s) -> ST s ByteString
forall (m :: * -> *).
Monad 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 ByteString
BSL.Empty  (DecompressStreamEnd 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 = [Char] -> m ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Codec.Compression.Lzma.decompressWith: trailing data"
        loop (BSL.Chunk ByteString
_ ByteString
_) (DecompressStreamEnd ByteString
_) =
            [Char] -> m ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Codec.Compression.Lzma.decompressWith: trailing data"
        loop ByteString
_ (DecompressStreamError LzmaRet
e) =
            [Char] -> m ByteString
forall a. HasCallStack => [Char] -> a
error ([Char]
"Codec.Compression.Lzma.decompressWith: decoding error " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LzmaRet -> [Char]
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 (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 ByteString
c ByteString
bs') (DecompressInputRequired 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 ByteString
ibs (DecompressOutputAvailable ByteString
oc 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 lazy 'ByteString' into @.xz@ format using 'defaultCompressParams'.
compress :: BSL.ByteString -> BSL.ByteString
compress :: ByteString -> ByteString
compress = CompressParams -> ByteString -> ByteString
compressWith CompressParams
defaultCompressParams

-- | Like 'compress' but with the ability to specify various compression
-- parameters. Typical usage:
--
-- > compressWith defaultCompressParams { compress... = ... }
compressWith :: CompressParams -> BSL.ByteString -> BSL.ByteString
compressWith :: CompressParams -> ByteString -> ByteString
compressWith CompressParams
parms 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' ByteString
ibs0 = ByteString -> CompressStream (ST s) -> ST s ByteString
forall (m :: * -> *).
Monad 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 ByteString
BSL.Empty  CompressStream m
CompressStreamEnd =
            ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
BSL.Empty
        loop (BSL.Chunk ByteString
_ ByteString
_) CompressStream m
CompressStreamEnd =
            [Char] -> m ByteString
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 (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 ByteString
c ByteString
bs') (CompressInputRequired m (CompressStream m)
_ 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 ByteString
ibs (CompressOutputAvailable ByteString
oc 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 #-}

--------------------------------------------------------------------------------
--------------------------------------------------------------------------------

-- Type derived from 'zlib' and augmented with flushing support

data CompressStream m =
     CompressInputRequired {- flush -}  (m (CompressStream m))
                           {- supply -} (ByteString -> m (CompressStream m))
       -- ^ Compression process requires input to proceed. You can
       -- either flush the stream (first field), supply an input chunk
       -- (second field), or signal the end of input (via empty
       -- chunk).
   | CompressOutputAvailable !ByteString (m (CompressStream m)) -- ^ Output chunk available.
   | CompressStreamEnd

-- | Incremental compression in the 'IO' monad.
compressIO :: CompressParams -> IO (CompressStream IO)
compressIO :: CompressParams -> IO (CompressStream IO)
compressIO 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 = Int
32752

    go :: LzmaStream -> IO (CompressStream IO)
    go :: LzmaStream -> IO (CompressStream IO)
go 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 ByteString
chunk = do
            (LzmaRet
rc, Int
used, 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
                LzmaRet
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
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                          [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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
_ -> 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

        -- drain encoder till LzmaRetStreamEnd is reported
        goSync :: LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO)
        goSync :: LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO)
goSync LzmaAction
LzmaRun IO (CompressStream IO)
_ = [Char] -> 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) <- 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
                    LzmaRet
LzmaRetOK
                        | ByteString -> Bool
BS.null ByteString
obuf -> [Char] -> IO (CompressStream IO)
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"compressIO: empty output chunk during " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LzmaAction -> [Char]
forall a. Show a => a -> [Char]
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')
                    LzmaRet
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
_ -> 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

-- | Incremental compression in the lazy 'ST' monad.
compressST :: CompressParams -> ST s (CompressStream (ST s))
compressST :: CompressParams -> ST s (CompressStream (ST s))
compressST 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 = Int
32752

    go :: LzmaStream -> m (CompressStream (ST s))
go 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 ByteString
chunk = do
            (LzmaRet
rc, Int
used, 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
                LzmaRet
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
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
                          [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"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
_ -> 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

        -- drain encoder till LzmaRetStreamEnd is reported
        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 LzmaAction
LzmaRun ST s (CompressStream (ST s))
_ = [Char] -> 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) <- 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)
                Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"compressST: n was not zero"
                case LzmaRet
rc of
                    LzmaRet
LzmaRetOK
                        | ByteString -> Bool
BS.null ByteString
obuf -> [Char] -> ST s (CompressStream (ST s))
forall a. HasCallStack => [Char] -> a
error ([Char]
"compressIO: empty output chunk during " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ LzmaAction -> [Char]
forall a. Show a => a -> [Char]
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')
                    LzmaRet
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
_ -> 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)) -- ^ Decoding process requires input to proceed. An empty 'ByteString' chunk signals end of input.
   | DecompressOutputAvailable !ByteString (m (DecompressStream m)) -- ^ Decompressed output chunk available.
   | DecompressStreamEnd ByteString -- ^ Decoded stream is finished. Any unconsumed leftovers from the input stream are returned via the 'ByteString' field
   | DecompressStreamError !LzmaRet -- TODO define subset-enum of LzmaRet

-- | Incremental decompression in the 'IO' monad.
decompressIO :: DecompressParams -> IO (DecompressStream IO)
decompressIO :: DecompressParams -> IO (DecompressStream IO)
decompressIO 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 = Int
32752

    go :: LzmaStream -> IO (DecompressStream IO)
    go :: LzmaStream -> IO (DecompressStream IO)
go 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 ByteString
chunk
          | ByteString -> Bool
BS.null ByteString
chunk = IO (DecompressStream IO)
goFinish
          | Bool
otherwise = do
            (LzmaRet
rc, Int
used, 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
                LzmaRet
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
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                          [Char] -> IO ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"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'))

                LzmaRet
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'))

                LzmaRet
_ -> 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 LzmaAction
action IO (DecompressStream IO)
next = IO (DecompressStream IO)
goSync'
          where
            goSync' :: IO (DecompressStream IO)
goSync' = do
                (LzmaRet
rc, Int
0, 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
                  LzmaRet
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')

                  LzmaRet
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)

                  LzmaRet
_ -> 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 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')

-- | Incremental decompression in the lazy 'ST' monad.
decompressST :: DecompressParams -> ST s (DecompressStream (ST s))
decompressST :: DecompressParams -> ST s (DecompressStream (ST s))
decompressST 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 = Int
32752

    go :: LzmaStream -> ST s (DecompressStream (ST s))
    go :: LzmaStream -> ST s (DecompressStream (ST s))
go 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 ByteString
chunk
          | ByteString -> Bool
BS.null ByteString
chunk = ST s (DecompressStream (ST s))
forall s. ST s (DecompressStream (ST s))
goFinish
          | Bool
otherwise = do
            (LzmaRet
rc, Int
used, 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
                LzmaRet
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
> Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$
                          [Char] -> ST s ()
forall a. HasCallStack => [Char] -> a
error [Char]
"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'))

                LzmaRet
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'))

                LzmaRet
_ -> 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 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) <- 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)
                Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ [Char] -> ST s ()
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    -> 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')

                  LzmaRet
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)

                  LzmaRet
_ -> 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 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')

-- | Small 'maybe'-ish helper distinguishing between empty and
-- non-empty 'ByteString's
withChunk :: t -> (ByteString -> t) -> ByteString -> t
withChunk :: 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

-- | See <https://github.com/haskell/zlib/issues/7>
noDuplicateST :: ST.Strict.ST s ()
noDuplicateST :: ST s ()
noDuplicateST = IO () -> ST s ()
forall a s. IO a -> ST s a
unsafeIOToST IO ()
noDuplicate