diff --git a/Data/Iteratee/ZLib.hsc b/Data/Iteratee/ZLib.hsc --- a/Data/Iteratee/ZLib.hsc +++ b/Data/Iteratee/ZLib.hsc @@ -20,6 +20,12 @@ WindowBits(..), MemoryLevel(..), CompressionStrategy(..), + enumSyncFlush, + enumFullFlush, + enumBlockFlush, + syncFlush, + fullFlush, + blockFlush, ) where #include @@ -31,6 +37,7 @@ import Data.ByteString.Internal import Data.Iteratee import Data.Iteratee.IO +import Data.Foldable import Data.Typeable import Foreign import Foreign.C @@ -141,12 +148,13 @@ compressStrategy :: !CompressionStrategy, -- | The size of output buffer. That is the size of 'Chunk's that will be -- emitted to inner iterator (except the last 'Chunk'). - compressBufferSize :: !Int + compressBufferSize :: !Int, + compressDictionary :: !(Maybe ByteString) } defaultCompressParams = CompressParams DefaultCompression Deflated DefaultWindowBits - DefaultMemoryLevel DefaultStrategy (8*1024) + DefaultMemoryLevel DefaultStrategy (8*1024) Nothing -- | Set of parameters for decompression. For sane defaults see -- 'defaultDecompressParams'. @@ -159,7 +167,8 @@ decompressWindowBits :: !WindowBits, -- | The size of output buffer. That is the size of 'Chunk's that will be -- emitted to inner iterator (except the last 'Chunk'). - decompressBufferSize :: !Int + decompressBufferSize :: !Int, + decompressDictionary :: !(Maybe ByteString) } defaultDecompressParams = DecompressParams DefaultWindowBits (8*1024) @@ -315,7 +324,7 @@ convParam :: Format -> CompressParams -> Either ZLibParamsException (CInt, CInt, CInt, CInt, CInt) -convParam f (CompressParams c m w l s _) +convParam f (CompressParams c m w l s _ _) = let c' = fromCompressionLevel c m' = fromMethod m b' = fromWindowBits f w @@ -601,6 +610,10 @@ deflateEnd :: FunPtr (Ptr ZStream -> IO ()) foreign import ccall unsafe "&inflateEnd" inflateEnd :: FunPtr (Ptr ZStream -> IO ()) +foreign import ccall unsafe deflateSetDictionary :: Ptr ZStream -> Ptr Word8 + -> CUInt -> IO CInt +foreign import ccall unsafe inflateSetDictionary :: Ptr ZStream -> Ptr Word8 + -> CUInt -> IO CInt deflateInit2 :: Ptr ZStream -> CInt -> CInt -> CInt -> CInt -> CInt -> IO CInt deflateInit2 s l m wB mL s' @@ -641,20 +654,32 @@ memset (castPtr zptr) 0 #{size z_stream} deflateInit2 zptr c m b l s `finally` addForeignPtrFinalizer deflateEnd zstr + for_ (compressDictionary cp) $ \(PS fp off len) -> + withForeignPtr fp $ \ptr -> + deflateSetDictionary zptr (ptr `plusPtr` off) + (fromIntegral len) return $! Right $! Initial $ ZStream zstr mkDecompress :: Format -> DecompressParams - -> IO (Either ZLibParamsException Initial) -mkDecompress frm cp@(DecompressParams wB _) - = case fromWindowBits frm wB of + -> IO (Either ZLibParamsException (Initial, Maybe ByteString)) +mkDecompress frm cp@(DecompressParams w _ md) + = case fromWindowBits frm w of Left err -> return $! Left err Right wB' -> do zstr <- mallocForeignPtrBytes #{size z_stream} - withForeignPtr zstr $ \zptr -> do + v <- withForeignPtr zstr $ \zptr -> do memset (castPtr zptr) 0 #{size z_stream} inflateInit2 zptr wB' `finally` addForeignPtrFinalizer inflateEnd zstr - return $! Right $! Initial $ ZStream zstr + case (md, frm) of + (Just (PS fp off len), Raw) -> do + withForeignPtr fp $ \ptr -> + inflateSetDictionary zptr (ptr `plusPtr` off) + (fromIntegral len) + return $! Nothing + (Nothing, _) -> return $! Nothing + (Just bs, _) -> return $! (Just bs) + return $! Right $! (Initial $ ZStream zstr, v) -- User-related code @@ -663,7 +688,7 @@ => Format -- ^ Format of input -> CompressParams -- ^ Parameters of compression -> Enumeratee ByteString ByteString m a -enumDeflate f cp@(CompressParams _ _ _ _ _ size) iter = do +enumDeflate f cp@(CompressParams _ _ _ _ _ size _) iter = do cmp <- liftIO $ mkCompress f cp case cmp of Left err -> do @@ -677,10 +702,58 @@ => Format -> DecompressParams -> Enumeratee ByteString ByteString m a -enumInflate f dp@(DecompressParams _ size) iter = do +enumInflate f dp@(DecompressParams _ size md) iter = do dcmp <- liftIO $ mkDecompress f dp case dcmp of Left err -> do _ <- lift $ enumErr err iter throwErr (toException err) - Right init -> insertOut size inflate' init iter + Right (init, Nothing) -> insertOut size inflate' init iter + Right (init, (Just (PS fp off len))) -> + let inflate'' zstr param = do + ret <- inflate' zstr param + case fromErrno ret of + Left NeedDictionary -> do + withForeignPtr fp $ \ptr -> + withZStream zstr $ \zptr -> + inflateSetDictionary zptr (ptr `plusPtr` off) + (fromIntegral len) + inflate' zstr param + _ -> return ret + in insertOut size inflate'' init iter + +enumSyncFlush :: Monad m => Enumerator ByteString m a +-- ^ Enumerate synchronise flush. It cause the all pending output to be flushed +-- and all available input is sent to inner Iteratee. +enumSyncFlush = enumErr SyncFlush + +syncFlush :: Monad m => Iteratee ByteString m () +-- ^ Flushes the stream requesting as much data as possible. +syncFlush = throwRecoverableErr (toException SyncFlush) (const identity) + +enumFullFlush :: Monad m => Enumerator ByteString m a +-- ^ Enumerate full flush. It flushes all pending output and reset the +-- compression. It allows to restart from this point if compressed data was +-- corrupted but it can affect the compression rate. +-- +-- It may be only used during compression. +enumFullFlush = enumErr FullFlush + +fullFlush :: Monad m => Iteratee ByteString m () +-- ^ Flush all pending output and reset the compression. It allows to restart +-- from this point if compressed data was corrupted but it can affect the +-- compression rate. +-- +-- It may be only used during compression. +fullFlush = throwRecoverableErr (toException FullFlush) (const identity) + +enumBlockFlush :: Monad m => Enumerator ByteString m a +-- ^ Enumerate block flush. If the enumerator is compressing it allows to +-- finish current block. If the enumerator is decompressing it forces to stop +-- on next block boundary. +enumBlockFlush = enumErr Block + +blockFlush :: Monad m => Iteratee ByteString m () +-- ^ If the enumerator is compressing it allows to finish current block. If +-- the enumerator is decompressing it forces to stop on next block boundary. +blockFlush = throwRecoverableErr (toException Block) (const identity) diff --git a/iteratee-compress.cabal b/iteratee-compress.cabal --- a/iteratee-compress.cabal +++ b/iteratee-compress.cabal @@ -1,5 +1,5 @@ Name: iteratee-compress -Version: 0.3.0.0 +Version: 0.3.1.0 Synopsis: An enumerators for compressing and decompressing streams Description: An enumerators for compressing and decompressing streams License: BSD3 @@ -21,8 +21,8 @@ Data.Iteratee.ZLib Build-depends: base >= 4 && < 5, bytestring >= 0.9 && < 0.10, - iteratee >= 0.4 && < 0.9, - mtl >= 2.0 && < 2.1 + iteratee >= 0.8.7 && < 0.9, + mtl >= 2.0 && < 2.2 Build-tools: c2hs Extensions: CPP, DeriveDataTypeable,