{-# 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
data CompressParams
= CompressParams
{ CompressParams -> Int
cpBlockSize :: Int
, CompressParams -> Int
cpVerbosity :: Int
, CompressParams -> Int
cpWorkFactor :: Int
}
instance Default CompressParams where
def :: CompressParams
def = Int -> Int -> Int -> CompressParams
CompressParams Int
9 Int
0 Int
30
data DecompressParams
= DecompressParams
{ DecompressParams -> Int
dpVerbosity :: Int
, DecompressParams -> Bool
dpSmall :: Bool
}
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
:: MonadResource m
=> CompressParams
-> 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
decompress1
:: MonadResource m
=> DecompressParams
-> 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
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
:: MonadResource m
=> DecompressParams
-> 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 :: 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
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