{-# LANGUAGE RecordWildCards #-}
module Data.Conduit.BZlib (
  compress,
  decompress1,
  decompress,

  bzip2,
  bunzip2,

  CompressParams(..),
  DecompressParams(..),
  def,
  ) where

import Control.Monad as CM
import Control.Monad.Trans
import Control.Monad.Trans.Resource
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as S
import Data.Conduit
import Data.Default.Class
import Data.Maybe
import Data.IORef
import Foreign
import Foreign.C

import Data.Conduit.BZlib.Internal

-- | Compression parameters

data CompressParams
  = CompressParams
    { CompressParams -> Int
cpBlockSize  :: Int -- ^ Compress level [1..9]. default is 9.

    , CompressParams -> Int
cpVerbosity  :: Int -- ^ Verbosity mode [0..4]. default is 0.

    , CompressParams -> Int
cpWorkFactor :: Int -- ^ Work factor [0..250]. default is 30.

    }

instance Default CompressParams where
  def :: CompressParams
def = Int -> Int -> Int -> CompressParams
CompressParams Int
9 Int
0 Int
30

-- | Decompression parameters

data DecompressParams
  = DecompressParams
    { DecompressParams -> Int
dpVerbosity :: Int -- ^ Verbosity mode [0..4]. default is 0

    , DecompressParams -> Bool
dpSmall     :: Bool -- ^ If True, use an algorithm uses less memory but slow. default is False

    }

instance Default DecompressParams where
  def :: DecompressParams
def = Int -> Bool -> DecompressParams
DecompressParams Int
0 Bool
False

bufSize :: Int
bufSize :: Int
bufSize = Int
4096

yieldAvailOutput :: MonadIO m => Ptr C'bz_stream -> ConduitT S.ByteString S.ByteString m ()
yieldAvailOutput :: forall (m :: * -> *).
MonadIO m =>
Ptr C'bz_stream -> ConduitT ByteString ByteString m ()
yieldAvailOutput Ptr C'bz_stream
ptr = do
  Int
availOut <- IO Int -> ConduitT ByteString ByteString m Int
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> ConduitT ByteString ByteString m Int)
-> IO Int -> ConduitT ByteString ByteString m Int
forall a b. (a -> b) -> a -> b
$ CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CUInt -> Int) -> IO CUInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr CUInt -> IO CUInt) -> Ptr CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'avail_out Ptr C'bz_stream
ptr)
  Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
availOut Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bufSize) (ConduitT ByteString ByteString m ()
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$
    m ByteString -> ConduitT ByteString ByteString m ()
forall (m :: * -> *) o i. Monad m => m o -> ConduitT i o m ()
yieldM (m ByteString -> ConduitT ByteString ByteString m ())
-> m ByteString -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
          let len :: Int
len = Int
bufSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
availOut
          Ptr CChar
p <- (Ptr CChar -> Int -> Ptr CChar
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (-Int
len)) (Ptr CChar -> Ptr CChar) -> IO (Ptr CChar) -> IO (Ptr CChar)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (Ptr CChar) -> IO (Ptr CChar))
-> Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> Ptr (Ptr CChar)
p'bz_stream'next_out Ptr C'bz_stream
ptr)
          ByteString
out <- CStringLen -> IO ByteString
S.packCStringLen (Ptr CChar
p, Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
          Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr C'bz_stream -> Ptr (Ptr CChar)
p'bz_stream'next_out Ptr C'bz_stream
ptr) Ptr CChar
p
          Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'avail_out Ptr C'bz_stream
ptr) (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSize)
          ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
out

fillInput :: Ptr C'bz_stream -> IORef (Ptr CChar, Int) -> S.ByteString -> IO ()
fillInput :: Ptr C'bz_stream -> IORef CStringLen -> ByteString -> IO ()
fillInput Ptr C'bz_stream
ptr IORef CStringLen
mv ByteString
bs = ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
S.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
p, Int
len) -> do
  (Ptr CChar
buf, Int
bsize) <- IORef CStringLen -> IO CStringLen
forall a. IORef a -> IO a
readIORef IORef CStringLen
mv
  let nsize :: Int
nsize = [Int] -> Int
forall a. HasCallStack => [a] -> a
head [ Int
s | Int
x <- [Int
0..], let s :: Int
s = Int
bsize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
x :: Int), Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len ]
  Ptr CChar
nbuf <- if Int
nsize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
bsize then Ptr CChar -> Int -> IO (Ptr CChar)
forall a. Ptr a -> Int -> IO (Ptr a)
reallocBytes Ptr CChar
buf Int
nsize else Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
buf
  Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CChar
nbuf Ptr CChar
p Int
len
  Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'avail_in Ptr C'bz_stream
ptr) (CUInt -> IO ()) -> CUInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
  Ptr (Ptr CChar) -> Ptr CChar -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr C'bz_stream -> Ptr (Ptr CChar)
p'bz_stream'next_in Ptr C'bz_stream
ptr) Ptr CChar
nbuf
  IORef CStringLen -> CStringLen -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef CStringLen
mv (Ptr CChar
nbuf, Int
nsize)

throwIfMinus :: String -> IO CInt -> IO CInt
throwIfMinus :: String -> IO CInt -> IO CInt
throwIfMinus String
s IO CInt
m = do
  CInt
r <- IO CInt
m
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
r
  CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
r

throwIfMinus_ :: String -> IO CInt -> IO ()
throwIfMinus_ :: String -> IO CInt -> IO ()
throwIfMinus_ String
s IO CInt
m = IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
CM.void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO CInt -> IO CInt
throwIfMinus String
s IO CInt
m

allocateStream :: MonadResource m => m (Ptr C'bz_stream, IORef (Ptr CChar, Int))
allocateStream :: forall (m :: * -> *).
MonadResource m =>
m (Ptr C'bz_stream, IORef CStringLen)
allocateStream = do
  (ReleaseKey
_, Ptr C'bz_stream
ptr)    <- IO (Ptr C'bz_stream)
-> (Ptr C'bz_stream -> IO ()) -> m (ReleaseKey, Ptr C'bz_stream)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate IO (Ptr C'bz_stream)
forall a. Storable a => IO (Ptr a)
malloc Ptr C'bz_stream -> IO ()
forall a. Ptr a -> IO ()
free
  (ReleaseKey
_, IORef CStringLen
inbuf)  <- IO (IORef CStringLen)
-> (IORef CStringLen -> IO ()) -> m (ReleaseKey, IORef CStringLen)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
bufSize IO (Ptr CChar)
-> (Ptr CChar -> IO (IORef CStringLen)) -> IO (IORef CStringLen)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr CChar
p -> CStringLen -> IO (IORef CStringLen)
forall a. a -> IO (IORef a)
newIORef (Ptr CChar
p, Int
bufSize))
                          (\IORef CStringLen
mv -> IORef CStringLen -> IO CStringLen
forall a. IORef a -> IO a
readIORef IORef CStringLen
mv IO CStringLen -> (CStringLen -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Ptr CChar
p, Int
_) -> Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
p)
  (ReleaseKey
_, Ptr CChar
outbuf) <- IO (Ptr CChar) -> (Ptr CChar -> IO ()) -> m (ReleaseKey, Ptr CChar)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes Int
bufSize) Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> C'bz_stream -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'bz_stream
ptr (C'bz_stream -> IO ()) -> C'bz_stream -> IO ()
forall a b. (a -> b) -> a -> b
$ C'bz_stream
    { c'bz_stream'next_in :: Ptr CChar
c'bz_stream'next_in        = Ptr CChar
forall a. Ptr a
nullPtr
    , c'bz_stream'avail_in :: CUInt
c'bz_stream'avail_in       = CUInt
0
    , c'bz_stream'total_in_lo32 :: CUInt
c'bz_stream'total_in_lo32  = CUInt
0
    , c'bz_stream'total_in_hi32 :: CUInt
c'bz_stream'total_in_hi32  = CUInt
0
    , c'bz_stream'next_out :: Ptr CChar
c'bz_stream'next_out       = Ptr CChar
outbuf
    , c'bz_stream'avail_out :: CUInt
c'bz_stream'avail_out      = Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSize
    , c'bz_stream'total_out_lo32 :: CUInt
c'bz_stream'total_out_lo32 = CUInt
0
    , c'bz_stream'total_out_hi32 :: CUInt
c'bz_stream'total_out_hi32 = CUInt
0
    , c'bz_stream'state :: Ptr ()
c'bz_stream'state          = Ptr ()
forall a. Ptr a
nullPtr
    , c'bz_stream'bzalloc :: Ptr ()
c'bz_stream'bzalloc        = Ptr ()
forall a. Ptr a
nullPtr
    , c'bz_stream'bzfree :: Ptr ()
c'bz_stream'bzfree         = Ptr ()
forall a. Ptr a
nullPtr
    , c'bz_stream'opaque :: Ptr ()
c'bz_stream'opaque         = Ptr ()
forall a. Ptr a
nullPtr
    }
  (Ptr C'bz_stream, IORef CStringLen)
-> m (Ptr C'bz_stream, IORef CStringLen)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr C'bz_stream
ptr, IORef CStringLen
inbuf)

-- | Compress a stream of ByteStrings.

compress
  :: MonadResource m
     => CompressParams -- ^ Compress parameter

     -> ConduitT S.ByteString S.ByteString m ()
compress :: forall (m :: * -> *).
MonadResource m =>
CompressParams -> ConduitT ByteString ByteString m ()
compress CompressParams {Int
cpBlockSize :: CompressParams -> Int
cpVerbosity :: CompressParams -> Int
cpWorkFactor :: CompressParams -> Int
cpBlockSize :: Int
cpVerbosity :: Int
cpWorkFactor :: Int
..} = do
  (Ptr C'bz_stream
ptr, IORef CStringLen
inbuf) <- m (Ptr C'bz_stream, IORef CStringLen)
-> ConduitT
     ByteString ByteString m (Ptr C'bz_stream, IORef CStringLen)
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT ByteString ByteString m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Ptr C'bz_stream, IORef CStringLen)
 -> ConduitT
      ByteString ByteString m (Ptr C'bz_stream, IORef CStringLen))
-> m (Ptr C'bz_stream, IORef CStringLen)
-> ConduitT
     ByteString ByteString m (Ptr C'bz_stream, IORef CStringLen)
forall a b. (a -> b) -> a -> b
$ m (Ptr C'bz_stream, IORef CStringLen)
forall (m :: * -> *).
MonadResource m =>
m (Ptr C'bz_stream, IORef CStringLen)
allocateStream
  (ReleaseKey, ())
_ <- m (ReleaseKey, ())
-> ConduitT ByteString ByteString m (ReleaseKey, ())
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT ByteString ByteString m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ReleaseKey, ())
 -> ConduitT ByteString ByteString m (ReleaseKey, ()))
-> m (ReleaseKey, ())
-> ConduitT ByteString ByteString m (ReleaseKey, ())
forall a b. (a -> b) -> a -> b
$ IO () -> (() -> IO ()) -> m (ReleaseKey, ())
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate
    (String -> IO CInt -> IO ()
throwIfMinus_ String
"bzCompressInit" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
     Ptr C'bz_stream -> CInt -> CInt -> CInt -> IO CInt
c'BZ2_bzCompressInit Ptr C'bz_stream
ptr
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cpBlockSize)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cpVerbosity)
     (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cpWorkFactor))
    (\()
_ -> String -> IO CInt -> IO ()
throwIfMinus_ String
"bzCompressEnd" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> IO CInt
c'BZ2_bzCompressEnd Ptr C'bz_stream
ptr)

  let loop :: ConduitT ByteString ByteString m ()
loop = do
        Maybe ByteString
mbinp <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
        case Maybe ByteString
mbinp of
          Just ByteString
inp -> do
            Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
S.null ByteString
inp) (ConduitT ByteString ByteString m ()
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
              IO () -> ConduitT ByteString ByteString m ()
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString ByteString m ())
-> IO () -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> IORef CStringLen -> ByteString -> IO ()
fillInput Ptr C'bz_stream
ptr IORef CStringLen
inbuf ByteString
inp
              Ptr C'bz_stream -> CInt -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Ptr C'bz_stream -> CInt -> ConduitT ByteString ByteString m ()
yields Ptr C'bz_stream
ptr CInt
forall a. Num a => a
c'BZ_RUN
            ConduitT ByteString ByteString m ()
loop
          Maybe ByteString
Nothing -> do
            Ptr C'bz_stream -> CInt -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Ptr C'bz_stream -> CInt -> ConduitT ByteString ByteString m ()
yields Ptr C'bz_stream
ptr CInt
forall a. Num a => a
c'BZ_FINISH
  ConduitT ByteString ByteString m ()
loop
  where
    yields :: MonadIO m => Ptr C'bz_stream -> CInt -> ConduitT S.ByteString S.ByteString m ()
    yields :: forall (m :: * -> *).
MonadIO m =>
Ptr C'bz_stream -> CInt -> ConduitT ByteString ByteString m ()
yields Ptr C'bz_stream
ptr CInt
action = do
      CInt
cont <- IO CInt -> ConduitT ByteString ByteString m CInt
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ConduitT ByteString ByteString m CInt)
-> IO CInt -> ConduitT ByteString ByteString m CInt
forall a b. (a -> b) -> a -> b
$ String -> IO CInt -> IO CInt
throwIfMinus String
"bzCompress" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> CInt -> IO CInt
c'BZ2_bzCompress Ptr C'bz_stream
ptr CInt
action
      Ptr C'bz_stream -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Ptr C'bz_stream -> ConduitT ByteString ByteString m ()
yieldAvailOutput Ptr C'bz_stream
ptr
      CUInt
availIn <- IO CUInt -> ConduitT ByteString ByteString m CUInt
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CUInt -> ConduitT ByteString ByteString m CUInt)
-> IO CUInt -> ConduitT ByteString ByteString m CUInt
forall a b. (a -> b) -> a -> b
$ Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr CUInt -> IO CUInt) -> Ptr CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'avail_in Ptr C'bz_stream
ptr
      Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CUInt
availIn CUInt -> CUInt -> Bool
forall a. Ord a => a -> a -> Bool
> CUInt
0 Bool -> Bool -> Bool
|| CInt
action CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'BZ_FINISH Bool -> Bool -> Bool
&& CInt
cont CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
forall a. Num a => a
c'BZ_STREAM_END) (ConduitT ByteString ByteString m ()
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$
        Ptr C'bz_stream -> CInt -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Ptr C'bz_stream -> CInt -> ConduitT ByteString ByteString m ()
yields Ptr C'bz_stream
ptr CInt
action

-- | Decompress a stream of ByteStrings. Note that this will only decompress

-- the first compressed stream in the input and leave the rest for further

-- processing. See 'decompress'.

decompress1
  :: MonadResource m
     => DecompressParams -- ^ Decompress parameter

     -> ConduitT S.ByteString S.ByteString m ()
decompress1 :: forall (m :: * -> *).
MonadResource m =>
DecompressParams -> ConduitT ByteString ByteString m ()
decompress1 DecompressParams {Bool
Int
dpVerbosity :: DecompressParams -> Int
dpSmall :: DecompressParams -> Bool
dpVerbosity :: Int
dpSmall :: Bool
..} = do
  (Ptr C'bz_stream
ptr, IORef CStringLen
inbuf) <- m (Ptr C'bz_stream, IORef CStringLen)
-> ConduitT
     ByteString ByteString m (Ptr C'bz_stream, IORef CStringLen)
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT ByteString ByteString m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Ptr C'bz_stream, IORef CStringLen)
 -> ConduitT
      ByteString ByteString m (Ptr C'bz_stream, IORef CStringLen))
-> m (Ptr C'bz_stream, IORef CStringLen)
-> ConduitT
     ByteString ByteString m (Ptr C'bz_stream, IORef CStringLen)
forall a b. (a -> b) -> a -> b
$ m (Ptr C'bz_stream, IORef CStringLen)
forall (m :: * -> *).
MonadResource m =>
m (Ptr C'bz_stream, IORef CStringLen)
allocateStream
  (ReleaseKey, ())
_ <- m (ReleaseKey, ())
-> ConduitT ByteString ByteString m (ReleaseKey, ())
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT ByteString ByteString m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (ReleaseKey, ())
 -> ConduitT ByteString ByteString m (ReleaseKey, ()))
-> m (ReleaseKey, ())
-> ConduitT ByteString ByteString m (ReleaseKey, ())
forall a b. (a -> b) -> a -> b
$ IO () -> (() -> IO ()) -> m (ReleaseKey, ())
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate
    (String -> IO CInt -> IO ()
throwIfMinus_ String
"bzDecompressInit" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
     Ptr C'bz_stream -> CInt -> CInt -> IO CInt
c'BZ2_bzDecompressInit Ptr C'bz_stream
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dpVerbosity) (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
dpSmall))
    (\()
_ -> String -> IO CInt -> IO ()
throwIfMinus_ String
"bzDecompressEnd" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> IO CInt
c'BZ2_bzDecompressEnd Ptr C'bz_stream
ptr)

  let loop :: ConduitT ByteString ByteString m ()
loop = do
        Maybe ByteString
mbinp <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
        case Maybe ByteString
mbinp of
          Just ByteString
inp | Bool -> Bool
not (ByteString -> Bool
S.null ByteString
inp) -> do
            IO () -> ConduitT ByteString ByteString m ()
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString ByteString m ())
-> IO () -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> IORef CStringLen -> ByteString -> IO ()
fillInput Ptr C'bz_stream
ptr IORef CStringLen
inbuf ByteString
inp
            Bool
cont <- Ptr C'bz_stream -> ConduitT ByteString ByteString m Bool
forall {m :: * -> *}.
MonadIO m =>
Ptr C'bz_stream -> ConduitT ByteString ByteString m Bool
yields Ptr C'bz_stream
ptr
            Bool
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cont (ConduitT ByteString ByteString m ()
 -> ConduitT ByteString ByteString m ())
-> ConduitT ByteString ByteString m ()
-> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ ConduitT ByteString ByteString m ()
loop
          Just ByteString
_ -> do
            ConduitT ByteString ByteString m ()
loop
          Maybe ByteString
Nothing -> do
            IO () -> ConduitT ByteString ByteString m ()
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT ByteString ByteString m ())
-> IO () -> ConduitT ByteString ByteString m ()
forall a b. (a -> b) -> a -> b
$ IOError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"unexpected EOF on decompress"
  ConduitT ByteString ByteString m ()
loop
  where
    yields :: Ptr C'bz_stream -> ConduitT ByteString ByteString m Bool
yields Ptr C'bz_stream
ptr = do
      CInt
ret <- IO CInt -> ConduitT ByteString ByteString m CInt
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ConduitT ByteString ByteString m CInt)
-> IO CInt -> ConduitT ByteString ByteString m CInt
forall a b. (a -> b) -> a -> b
$ String -> IO CInt -> IO CInt
throwIfMinus String
"BZ2_bzDecompress" (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> IO CInt
c'BZ2_bzDecompress Ptr C'bz_stream
ptr
      Ptr C'bz_stream -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadIO m =>
Ptr C'bz_stream -> ConduitT ByteString ByteString m ()
yieldAvailOutput Ptr C'bz_stream
ptr
      CUInt
availIn <- IO CUInt -> ConduitT ByteString ByteString m CUInt
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CUInt -> ConduitT ByteString ByteString m CUInt)
-> IO CUInt -> ConduitT ByteString ByteString m CUInt
forall a b. (a -> b) -> a -> b
$ Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr CUInt -> IO CUInt) -> Ptr CUInt -> IO CUInt
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> Ptr CUInt
p'bz_stream'avail_in Ptr C'bz_stream
ptr
      if CUInt
availIn CUInt -> CUInt -> Bool
forall a. Ord a => a -> a -> Bool
> CUInt
0
        then
            -- bzip2 files can contain multiple concatenated streams, but the

            -- API requires that we close the stream and start a new

            -- decompression session.

            if CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'BZ_STREAM_END
                then do
                    Ptr CChar
dataIn <- IO (Ptr CChar) -> ConduitT ByteString ByteString m (Ptr CChar)
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CChar) -> ConduitT ByteString ByteString m (Ptr CChar))
-> IO (Ptr CChar) -> ConduitT ByteString ByteString m (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek (Ptr (Ptr CChar) -> IO (Ptr CChar))
-> Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Ptr C'bz_stream -> Ptr (Ptr CChar)
p'bz_stream'next_in Ptr C'bz_stream
ptr
                    ByteString
unread <- IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a. IO a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ConduitT ByteString ByteString m ByteString)
-> IO ByteString -> ConduitT ByteString ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
S.packCStringLen (Ptr CChar
dataIn, CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
availIn)
                    ByteString -> ConduitT ByteString ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
unread
                    Bool -> ConduitT ByteString ByteString m Bool
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                else Ptr C'bz_stream -> ConduitT ByteString ByteString m Bool
yields Ptr C'bz_stream
ptr
        else Bool -> ConduitT ByteString ByteString m Bool
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ConduitT ByteString ByteString m Bool)
-> Bool -> ConduitT ByteString ByteString m Bool
forall a b. (a -> b) -> a -> b
$ CInt
ret CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
forall a. Num a => a
c'BZ_OK

-- Decompress all the compressed bzip2 streams in the input, as the bzip2

-- command line tool.

decompress
  :: MonadResource m
     => DecompressParams -- ^ Decompress parameter

     -> ConduitT S.ByteString S.ByteString m ()
decompress :: forall (m :: * -> *).
MonadResource m =>
DecompressParams -> ConduitT ByteString ByteString m ()
decompress DecompressParams
params = do
    Maybe ByteString
next <- ConduitT ByteString ByteString m (Maybe ByteString)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
    case Maybe ByteString
next of
        Maybe ByteString
Nothing -> () -> ConduitT ByteString ByteString m ()
forall a. a -> ConduitT ByteString ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ByteString
bs
            | ByteString -> Bool
S.null ByteString
bs -> DecompressParams -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadResource m =>
DecompressParams -> ConduitT ByteString ByteString m ()
decompress DecompressParams
params
            | Bool
otherwise -> do
                ByteString -> ConduitT ByteString ByteString m ()
forall i o (m :: * -> *). i -> ConduitT i o m ()
leftover ByteString
bs
                DecompressParams -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadResource m =>
DecompressParams -> ConduitT ByteString ByteString m ()
decompress1 DecompressParams
params
                DecompressParams -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadResource m =>
DecompressParams -> ConduitT ByteString ByteString m ()
decompress DecompressParams
params
-- | bzip2 compression with default parameters.

bzip2 :: MonadResource m => ConduitT S.ByteString S.ByteString m ()
bzip2 :: forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString ByteString m ()
bzip2 = CompressParams -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadResource m =>
CompressParams -> ConduitT ByteString ByteString m ()
compress CompressParams
forall a. Default a => a
def

-- | bzip2 decompression with default parameters. This will decompress all the

-- streams in the input

bunzip2 :: MonadResource m => ConduitT S.ByteString S.ByteString m ()
bunzip2 :: forall (m :: * -> *).
MonadResource m =>
ConduitT ByteString ByteString m ()
bunzip2 = DecompressParams -> ConduitT ByteString ByteString m ()
forall (m :: * -> *).
MonadResource m =>
DecompressParams -> ConduitT ByteString ByteString m ()
decompress DecompressParams
forall a. Default a => a
def