diff --git a/Codec/Compression/GZip.hs b/Codec/Compression/GZip.hs --- a/Codec/Compression/GZip.hs +++ b/Codec/Compression/GZip.hs @@ -46,10 +46,25 @@ -- ** The compression parameter types CompressionLevel(..), + defaultCompression, + noCompression, + bestSpeed, + bestCompression, + compressionLevel, Method(..), + deflateMethod, WindowBits(..), + defaultWindowBits, + windowBits, MemoryLevel(..), + defaultMemoryLevel, + minMemoryLevel, + maxMemoryLevel, + memoryLevel, CompressionStrategy(..), + defaultStrategy, + filteredStrategy, + huffmanOnlyStrategy, ) where @@ -77,7 +92,7 @@ -- stream before doing any IO action that depends on it. -- decompress :: ByteString -> ByteString -decompress = Internal.decompress GZip defaultDecompressParams +decompress = decompressWith defaultDecompressParams -- | Like 'decompress' but with the ability to specify various decompression @@ -86,7 +101,7 @@ -- > decompressWith defaultCompressParams { ... } -- decompressWith :: DecompressParams -> ByteString -> ByteString -decompressWith = Internal.decompress GZip +decompressWith = Internal.decompress gzipFormat -- | Compress a stream of data into the gzip format. @@ -99,7 +114,7 @@ -- parameters. -- compress :: ByteString -> ByteString -compress = Internal.compress GZip defaultCompressParams +compress = compressWith defaultCompressParams -- | Like 'compress' but with the ability to specify various compression @@ -112,4 +127,4 @@ -- > compressWith defaultCompressParams { compressLevel = BestCompression } -- compressWith :: CompressParams -> ByteString -> ByteString -compressWith = Internal.compress GZip +compressWith = Internal.compress gzipFormat diff --git a/Codec/Compression/Zlib.hs b/Codec/Compression/Zlib.hs --- a/Codec/Compression/Zlib.hs +++ b/Codec/Compression/Zlib.hs @@ -34,10 +34,25 @@ -- ** The compression parameter types CompressionLevel(..), + defaultCompression, + noCompression, + bestSpeed, + bestCompression, + compressionLevel, Method(..), + deflateMethod, WindowBits(..), + defaultWindowBits, + windowBits, MemoryLevel(..), + defaultMemoryLevel, + minMemoryLevel, + maxMemoryLevel, + memoryLevel, CompressionStrategy(..), + defaultStrategy, + filteredStrategy, + huffmanOnlyStrategy, ) where @@ -65,7 +80,7 @@ -- stream before doing any IO action that depends on it. -- decompress :: ByteString -> ByteString -decompress = Internal.decompress Zlib defaultDecompressParams +decompress = decompressWith defaultDecompressParams -- | Like 'decompress' but with the ability to specify various decompression @@ -74,7 +89,7 @@ -- > decompressWith defaultCompressParams { ... } -- decompressWith :: DecompressParams -> ByteString -> ByteString -decompressWith = Internal.decompress Zlib +decompressWith = Internal.decompress zlibFormat -- | Compress a stream of data into the zlib format. @@ -87,7 +102,7 @@ -- parameters. -- compress :: ByteString -> ByteString -compress = Internal.compress Zlib defaultCompressParams +compress = compressWith defaultCompressParams -- | Like 'compress' but with the ability to specify various compression @@ -100,4 +115,4 @@ -- > compressWith defaultCompressParams { compressLevel = BestCompression } -- compressWith :: CompressParams -> ByteString -> ByteString -compressWith = Internal.compress Zlib +compressWith = Internal.compress zlibFormat diff --git a/Codec/Compression/Zlib/Internal.hs b/Codec/Compression/Zlib/Internal.hs --- a/Codec/Compression/Zlib/Internal.hs +++ b/Codec/Compression/Zlib/Internal.hs @@ -25,11 +25,35 @@ -- * The compression parameter types Stream.Format(..), + Stream.gzipFormat, + Stream.zlibFormat, + Stream.rawFormat, + Stream.gzipOrZlibFormat, Stream.CompressionLevel(..), + Stream.defaultCompression, + Stream.noCompression, + Stream.bestSpeed, + Stream.bestCompression, + Stream.compressionLevel, Stream.Method(..), + Stream.deflateMethod, Stream.WindowBits(..), + Stream.defaultWindowBits, + Stream.windowBits, Stream.MemoryLevel(..), + Stream.defaultMemoryLevel, + Stream.minMemoryLevel, + Stream.maxMemoryLevel, + Stream.memoryLevel, Stream.CompressionStrategy(..), + Stream.defaultStrategy, + Stream.filteredStrategy, + Stream.huffmanOnlyStrategy, + + -- * Low-level API to get explicit error reports + decompressWithErrors, + DecompressStream(..), + DecompressError(..), ) where import Prelude hiding (length) @@ -57,12 +81,12 @@ -- chunks. -- data CompressParams = CompressParams { - compressLevel :: Stream.CompressionLevel, - compressMethod :: Stream.Method, - compressWindowBits :: Stream.WindowBits, - compressMemoryLevel :: Stream.MemoryLevel, - compressStrategy :: Stream.CompressionStrategy, - compressBufferSize :: Int + compressLevel :: !Stream.CompressionLevel, + compressMethod :: !Stream.Method, + compressWindowBits :: !Stream.WindowBits, + compressMemoryLevel :: !Stream.MemoryLevel, + compressStrategy :: !Stream.CompressionStrategy, + compressBufferSize :: !Int } -- | The full set of parameters for decompression. The defaults are @@ -85,29 +109,29 @@ -- @'Data.ByteString.concat' . 'Data.ByteString.Lazy.toChunks'@. -- data DecompressParams = DecompressParams { - decompressWindowBits :: Stream.WindowBits, - decompressBufferSize :: Int + decompressWindowBits :: !Stream.WindowBits, + decompressBufferSize :: !Int } -- | The default set of parameters for compression. This is typically used with --- the @compressWith@ function with specific paramaters overridden. +-- the @compressWith@ function with specific parameters overridden. -- defaultCompressParams :: CompressParams defaultCompressParams = CompressParams { - compressLevel = Stream.DefaultCompression, - compressMethod = Stream.Deflated, - compressWindowBits = Stream.DefaultWindowBits, - compressMemoryLevel = Stream.DefaultMemoryLevel, - compressStrategy = Stream.DefaultStrategy, + compressLevel = Stream.defaultCompression, + compressMethod = Stream.deflateMethod, + compressWindowBits = Stream.defaultWindowBits, + compressMemoryLevel = Stream.defaultMemoryLevel, + compressStrategy = Stream.defaultStrategy, compressBufferSize = defaultCompressBufferSize } -- | The default set of parameters for decompression. This is typically used with --- the @compressWith@ function with specific paramaters overridden. +-- the @compressWith@ function with specific parameters overridden. -- defaultDecompressParams :: DecompressParams defaultDecompressParams = DecompressParams { - decompressWindowBits = Stream.DefaultWindowBits, + decompressWindowBits = Stream.defaultWindowBits, decompressBufferSize = defaultDecompressBufferSize } @@ -123,7 +147,65 @@ defaultDecompressBufferSize = 32 * 1024 - L.chunkOverhead #endif -{-# NOINLINE compress #-} +-- | A sequence of chunks of data produced from decompression. +-- +-- The difference from a simple list is that it contains a representation of +-- errors as data rather than as exceptions. This allows you to handle error +-- conditions explicitly. +-- +data DecompressStream = StreamEnd + | StreamChunk S.ByteString DecompressStream + + -- | An error code and a human readable error message. + | StreamError DecompressError String + +-- | The possible error cases when decompressing a stream. +-- +data DecompressError = + -- | The compressed data stream ended prematurely. This may happen if the + -- input data stream was truncated. + TruncatedInput + + -- | It is possible to do zlib compression with a custom dictionary. This + -- allows slightly higher compression ratios for short files. However such + -- compressed streams require the same dictionary when decompressing. This + -- zlib binding does not currently support custom dictionaries. This error + -- is for when we encounter a compressed stream that needs a dictionary. + | DictionaryRequired + + -- | If the compressed data stream is corrupted in any way then you will + -- get this error, for example if the input data just isn't a compressed + -- zlib data stream. In particular if the data checksum turns out to be + -- wrong then you will get all the decompressed data but this error at the + -- end, instead of the normal sucessful 'StreamEnd'. + | DataError + +-- | Fold an 'DecompressionStream'. Just like 'foldr' but with an extra error +-- case. For example to convert to a list and translate the errors into exceptions: +-- +-- > foldDecompressStream (:) [] (\code msg -> error msg) +-- +foldDecompressStream :: (S.ByteString -> a -> a) -> a + -> (DecompressError -> String -> a) + -> DecompressStream -> a +foldDecompressStream chunk end err = fold + where + fold StreamEnd = end + fold (StreamChunk bs stream) = chunk bs (fold stream) + fold (StreamError code msg) = err code msg + +fromDecompressStream :: DecompressStream -> L.ByteString +fromDecompressStream = + foldDecompressStream L.Chunk L.Empty + (\_code msg -> error ("Codec.Compression.Zlib: " ++ msg)) + +-- | Compress a data stream. +-- +-- There are no expected error conditions. All input data streams are valid. It +-- is possible for unexpected errors to occur, such as running out of memory, +-- or finding the wrong version of the zlib C library, these are thrown as +-- exceptions. +-- compress :: Stream.Format -> CompressParams @@ -151,7 +233,9 @@ -> [S.ByteString] -> Stream [S.ByteString] fillBuffers outChunkSize inChunks = do +#ifdef DEBUG Stream.consistencyCheck +#endif -- in this state there are two possabilities: -- * no outbut buffer space is available @@ -211,18 +295,42 @@ return [S.PS outFPtr offset length] else do Stream.finalise return [] - Stream.BufferError -> fail "BufferError should be impossible!" - Stream.NeedDict -> fail "NeedDict is impossible!" + Stream.Error code msg -> case code of + Stream.BufferError -> fail "BufferError should be impossible!" + Stream.NeedDict -> fail "NeedDict is impossible!" + _ -> fail msg -{-# NOINLINE decompress #-} + +-- | Decompress a data stream. +-- +-- It will throw an exception if any error is encountered in the input data. If +-- you need more control over error handling then use 'decompressWithErrors'. +-- decompress :: Stream.Format -> DecompressParams -> L.ByteString -> L.ByteString -decompress format (DecompressParams bits initChunkSize) input = - L.fromChunks $ Stream.run $ do +decompress format params = fromDecompressStream + . decompressWithErrors format params + +-- | Like 'decompress' but returns a 'DecompressStream' data structure that +-- contains an explicit representation of the error conditions that one may +-- encounter when decompressing. +-- +-- Note that in addition to errors in the input data, it is possible for other +-- unexpected errors to occur, such as out of memory, or finding the wrong +-- version of the zlib C library, these are still thrown as exceptions (because +-- representing them as data would make this function impure). +-- +decompressWithErrors + :: Stream.Format + -> DecompressParams + -> L.ByteString + -> DecompressStream +decompressWithErrors format (DecompressParams bits initChunkSize) input = + Stream.run $ do Stream.inflateInit format bits case L.toChunks input of [] -> fillBuffers 4 [] --always an error anyway @@ -239,8 +347,11 @@ fillBuffers :: Int -> [S.ByteString] - -> Stream [S.ByteString] + -> Stream DecompressStream fillBuffers outChunkSize inChunks = do +#ifdef DEBUG + Stream.consistencyCheck +#endif -- in this state there are two possabilities: -- * no outbut buffer space is available @@ -267,7 +378,7 @@ drainBuffers :: [S.ByteString] - -> Stream [S.ByteString] + -> Stream DecompressStream drainBuffers inChunks = do inputBufferEmpty' <- Stream.inputBufferEmpty @@ -286,19 +397,27 @@ then do (outFPtr, offset, length) <- Stream.popOutputBuffer outChunks <- Stream.unsafeInterleave (fillBuffers defaultDecompressBufferSize inChunks) - return (S.PS outFPtr offset length : outChunks) + return $ StreamChunk (S.PS outFPtr offset length) outChunks else do fillBuffers defaultDecompressBufferSize inChunks - Stream.StreamEnd -> do - -- Note that there may be input bytes still available if the stream - -- is embeded in some other data stream. Here we just silently discard - -- any trailing data. - outputBufferBytesAvailable <- Stream.outputBufferBytesAvailable - if outputBufferBytesAvailable > 0 - then do (outFPtr, offset, length) <- Stream.popOutputBuffer - Stream.finalise - return [S.PS outFPtr offset length] - else do Stream.finalise - return [] - Stream.BufferError -> fail "premature end of compressed stream" - Stream.NeedDict -> fail "compressed stream needs a custom dictionary" + Stream.StreamEnd -> finish StreamEnd + Stream.Error code msg -> case code of + Stream.BufferError -> finish (StreamError TruncatedInput msg') + where msg' = "premature end of compressed stream" + Stream.NeedDict -> finish (StreamError DictionaryRequired msg) + Stream.DataError -> finish (StreamError DataError msg) + _ -> fail msg + + -- Note even if we end with an error we still try to flush the last chunk if + -- there is one. The user just has to decide what they want to trust. + finish end = do + -- Note that there may be input bytes still available if the stream + -- is embeded in some other data stream. Here we just silently discard + -- any trailing data. + outputBufferBytesAvailable <- Stream.outputBufferBytesAvailable + if outputBufferBytesAvailable > 0 + then do (outFPtr, offset, length) <- Stream.popOutputBuffer + Stream.finalise + return (StreamChunk (S.PS outFPtr offset length) end) + else do Stream.finalise + return end diff --git a/Codec/Compression/Zlib/Raw.hs b/Codec/Compression/Zlib/Raw.hs --- a/Codec/Compression/Zlib/Raw.hs +++ b/Codec/Compression/Zlib/Raw.hs @@ -30,10 +30,25 @@ -- ** The compression parameter types CompressionLevel(..), + defaultCompression, + noCompression, + bestSpeed, + bestCompression, + compressionLevel, Method(..), + deflateMethod, WindowBits(..), + defaultWindowBits, + windowBits, MemoryLevel(..), + defaultMemoryLevel, + minMemoryLevel, + maxMemoryLevel, + memoryLevel, CompressionStrategy(..), + defaultStrategy, + filteredStrategy, + huffmanOnlyStrategy, ) where @@ -43,13 +58,13 @@ import Codec.Compression.Zlib.Internal hiding (compress, decompress) decompress :: ByteString -> ByteString -decompress = Internal.decompress Raw defaultDecompressParams +decompress = decompressWith defaultDecompressParams decompressWith :: DecompressParams -> ByteString -> ByteString -decompressWith = Internal.decompress Raw +decompressWith = Internal.decompress rawFormat compress :: ByteString -> ByteString -compress = Internal.compress Raw defaultCompressParams +compress = compressWith defaultCompressParams compressWith :: CompressParams -> ByteString -> ByteString -compressWith = Internal.compress Raw +compressWith = Internal.compress rawFormat diff --git a/Codec/Compression/Zlib/Stream.hsc b/Codec/Compression/Zlib/Stream.hsc --- a/Codec/Compression/Zlib/Stream.hsc +++ b/Codec/Compression/Zlib/Stream.hsc @@ -26,17 +26,37 @@ -- ** Initialisation parameters Format(..), + gzipFormat, + zlibFormat, + rawFormat, + gzipOrZlibFormat, CompressionLevel(..), + defaultCompression, + noCompression, + bestSpeed, + bestCompression, + compressionLevel, Method(..), + deflateMethod, WindowBits(..), + defaultWindowBits, + windowBits, MemoryLevel(..), + defaultMemoryLevel, + minMemoryLevel, + maxMemoryLevel, + memoryLevel, CompressionStrategy(..), + defaultStrategy, + filteredStrategy, + huffmanOnlyStrategy, -- * The buisness deflate, inflate, Status(..), Flush(..), + ErrorCode(..), -- * Buffer management -- ** Input buffer @@ -50,10 +70,12 @@ outputBufferSpaceRemaining, outputBufferFull, +#ifdef DEBUG -- * Debugging consistencyCheck, dump, trace, +#endif ) where @@ -70,9 +92,11 @@ import Data.ByteString.Internal (nullForeignPtr) #endif import System.IO.Unsafe (unsafeInterleaveIO) -import System.IO (hPutStrLn, stderr) import Control.Monad (liftM) import Control.Exception (assert) +#ifdef DEBUG +import System.IO (hPutStrLn, stderr) +#endif import Prelude hiding (length) @@ -161,7 +185,7 @@ -- you only need to supply a new buffer when there is no more output buffer -- space remaining outputBufferFull :: Stream Bool -outputBufferFull = getOutFree >>= return . (==0) +outputBufferFull = liftM (==0) outputBufferSpaceRemaining -- you can only run this when the output buffer is not empty @@ -269,6 +293,8 @@ (_,_,_,_,a) <- m stream nullForeignPtr nullForeignPtr 0 0 return a +-- This is marked as unsafe because run uses unsafePerformIO so anything +-- lifted here will end up being unsafePerformIO'd. unsafeLiftIO :: IO a -> Stream a unsafeLiftIO m = Z $ \_stream inBuf outBuf outOffset outLength -> do a <- m @@ -323,6 +349,7 @@ -- Debug stuff -- +#ifdef DEBUG trace :: String -> Stream () trace = unsafeLiftIO . hPutStrLn stderr @@ -360,6 +387,7 @@ let outBufPtr = unsafeForeignPtrToPtr outBuf assert (outBufPtr `plusPtr` (outOffset + outAvail) == outNext) $ return () +#endif ---------------------------- @@ -369,37 +397,46 @@ data Status = Ok | StreamEnd - | NeedDict + | Error ErrorCode String + +data ErrorCode = + NeedDict + | FileError + | StreamError + | DataError + | MemoryError | BufferError -- ^ No progress was possible or there was not enough room in -- the output buffer when 'Finish' is used. Note that -- 'BuferError' is not fatal, and 'inflate' can be called -- again with more input and more output space to continue. + | VersionError + | Unexpected -toStatus :: CInt -> Status -toStatus (#{const Z_OK}) = Ok -toStatus (#{const Z_STREAM_END}) = StreamEnd -toStatus (#{const Z_NEED_DICT}) = NeedDict -toStatus (#{const Z_BUF_ERROR}) = BufferError -toStatus other = error ("unexpected zlib status: " ++ show other) +toStatus :: CInt -> Stream Status +toStatus errno = case errno of + (#{const Z_OK}) -> return Ok + (#{const Z_STREAM_END}) -> return StreamEnd + (#{const Z_NEED_DICT}) -> err NeedDict "custom dictionary needed" + (#{const Z_BUF_ERROR}) -> err BufferError "buffer error" + (#{const Z_ERRNO}) -> err FileError "file error" + (#{const Z_STREAM_ERROR}) -> err StreamError "stream error" + (#{const Z_DATA_ERROR}) -> err DataError "data error" + (#{const Z_MEM_ERROR}) -> err MemoryError "insufficient memory" + (#{const Z_VERSION_ERROR}) -> err VersionError "incompatible zlib version" + other -> return $ Error Unexpected + ("unexpected zlib status: " ++ show other) + where + err errCode altMsg = liftM (Error errCode) $ do + msgPtr <- withStreamPtr (#{peek z_stream, msg}) + if msgPtr /= nullPtr + then unsafeLiftIO (peekCAString msgPtr) + else return altMsg failIfError :: CInt -> Stream () -failIfError errno - | errno >= 0 - || errno == #{const Z_BUF_ERROR} = return () - | otherwise = fail =<< getErrorMessage errno +failIfError errno = toStatus errno >>= \status -> case status of + (Error _ msg) -> fail msg + _ -> return () -getErrorMessage :: CInt -> Stream String -getErrorMessage errno = do - msgPtr <- withStreamPtr (#{peek z_stream, msg}) - if msgPtr /= nullPtr - then unsafeLiftIO (peekCAString msgPtr) - else return $ case errno of - #{const Z_ERRNO} -> "file error" - #{const Z_STREAM_ERROR} -> "stream error" - #{const Z_DATA_ERROR} -> "data error" - #{const Z_MEM_ERROR} -> "insufficient memory" - #{const Z_VERSION_ERROR} -> "incompatible version" - _ -> "unknown error" data Flush = NoFlush @@ -415,62 +452,116 @@ fromFlush Finish = #{const Z_FINISH} -- fromFlush Block = #{const Z_BLOCK} + -- | The format used for compression or decompression. There are three -- variations. -- -data Format = - GZip -- ^ The gzip format uses a header with a checksum and some optional - -- meta-data about the compressed file. It is intended primarily for - -- compressing individual files but is also sometimes used for network - -- protocols such as HTTP. The format is described in detail in RFC - -- #1952 +data Format = GZip | Zlib | Raw | GZipOrZlib + deriving Eq - | Zlib -- | The zlib format uses a minimal header with a checksum but no - -- other meta-data. It is especially designed for use in network - -- protocols. The format is described in detail in RFC #1950 - -- +{-# DEPRECATED GZip "Use gzipFormat. Format constructors will be hidden in version 0.7" #-} +{-# DEPRECATED Zlib "Use zlibFormat. Format constructors will be hidden in version 0.7" #-} +{-# DEPRECATED Raw "Use rawFormat. Format constructors will be hidden in version 0.7" #-} +{-# DEPRECATED GZipOrZlib "Use gzipOrZlibFormat. Format constructors will be hidden in version 0.7" #-} - | Raw -- | The \'raw\' format is just the compressed data stream without any - -- additional header, meta-data or data-integrity checksum. The format - -- is described in detail in RFC #1951 - -- +-- | The gzip format uses a header with a checksum and some optional meta-data +-- about the compressed file. It is intended primarily for compressing +-- individual files but is also sometimes used for network protocols such as +-- HTTP. The format is described in detail in RFC #1952 +-- +-- +gzipFormat :: Format +gzipFormat = GZip - | GZipOrZlib -- ^ This is not a format as such. It enabled zlib or gzip - -- decoding with automatic header detection. This only makes - -- sense for decompression. - deriving Eq +-- | The zlib format uses a minimal header with a checksum but no other +-- meta-data. It is especially designed for use in network protocols. The +-- format is described in detail in RFC #1950 +-- +-- +zlibFormat :: Format +zlibFormat = Zlib +-- | The \'raw\' format is just the compressed data stream without any +-- additional header, meta-data or data-integrity checksum. The format is +-- described in detail in RFC #1951 +-- +rawFormat :: Format +rawFormat = Raw + +-- | This is not a format as such. It enabled zlib or gzip decoding with +-- automatic header detection. This only makes sense for decompression. +-- +gzipOrZlibFormat :: Format +gzipOrZlibFormat = GZipOrZlib + + -- | The compression method -- -data Method = Deflated -- ^ \'Deflate\' is the only method supported in this - -- version of zlib. Indeed it is likely to be the only - -- method that ever will be supported. +data Method = Deflated +{-# DEPRECATED Deflated "Use deflateMethod. Method constructors will be hidden in version 0.7" #-} + +-- | \'Deflate\' is the only method supported in this version of zlib. +-- Indeed it is likely to be the only method that ever will be supported. +-- +deflateMethod :: Method +deflateMethod = Deflated + fromMethod :: Method -> CInt fromMethod Deflated = #{const Z_DEFLATED} + -- | The compression level parameter controls the amount of compression. This -- is a trade-off between the amount of compression and the time required to do -- the compression. -- data CompressionLevel = - DefaultCompression -- ^ The default compression level is 6 (that is, - -- biased towards higher compression at expense of - -- speed). - | NoCompression -- ^ No compression, just a block copy. - | BestSpeed -- ^ The fastest compression method (less compression) - | BestCompression -- ^ The slowest compression method (best compression). - | CompressionLevel Int -- ^ A specific compression level between 1 and 9. + DefaultCompression + | NoCompression + | BestSpeed + | BestCompression + | CompressionLevel Int +{-# DEPRECATED DefaultCompression "Use defaultCompression. CompressionLevel constructors will be hidden in version 0.7" #-} +{-# DEPRECATED NoCompression "Use noCompression. CompressionLevel constructors will be hidden in version 0.7" #-} +{-# DEPRECATED BestSpeed "Use bestSpeed. CompressionLevel constructors will be hidden in version 0.7" #-} +{-# DEPRECATED BestCompression "Use bestCompression. CompressionLevel constructors will be hidden in version 0.7" #-} +--FIXME: cannot deprecate constructor named the same as the type +{- DEPRECATED CompressionLevel "Use compressionLevel. CompressionLevel constructors will be hidden in version 0.7" -} + +-- | The default compression level is 6 (that is, biased towards higher +-- compression at expense of speed). +defaultCompression :: CompressionLevel +defaultCompression = DefaultCompression + +-- | No compression, just a block copy. +noCompression :: CompressionLevel +noCompression = CompressionLevel 0 + +-- | The fastest compression method (less compression) +bestSpeed :: CompressionLevel +bestSpeed = CompressionLevel 1 + +-- | The slowest compression method (best compression). +bestCompression :: CompressionLevel +bestCompression = CompressionLevel 9 + +-- | A specific compression level between 0 and 9. +compressionLevel :: Int -> CompressionLevel +compressionLevel n + | n >= 0 && n <= 9 = CompressionLevel n + | otherwise = error "CompressionLevel must be in the range 0..9" + fromCompressionLevel :: CompressionLevel -> CInt fromCompressionLevel DefaultCompression = -1 fromCompressionLevel NoCompression = 0 fromCompressionLevel BestSpeed = 1 fromCompressionLevel BestCompression = 9 fromCompressionLevel (CompressionLevel n) - | n >= 1 && n <= 9 = fromIntegral n + | n >= 0 && n <= 9 = fromIntegral n | otherwise = error "CompressLevel must be in the range 1..9" + -- | This specifies the size of the compression window. Larger values of this -- parameter result in better compression at the expense of higher memory -- usage. @@ -483,11 +574,31 @@ -- The total amount of memory used depends on the window bits and the -- 'MemoryLevel'. See the 'MemoryLevel' for the details. -- -data WindowBits = DefaultWindowBits - | WindowBits Int +data WindowBits = WindowBits Int + | DefaultWindowBits -- This constructor must be last to make + -- the Ord instance work. The Ord instance + -- is defined with and used by the tests. + -- It makse sense because the default value + -- is is also the max value at 15. -windowBits :: Format -> WindowBits-> CInt -windowBits format bits = (formatModifier format) (checkWindowBits bits) +{-# DEPRECATED DefaultWindowBits "Use defaultWindowBits. WindowBits constructors will be hidden in version 0.7" #-} +--FIXME: cannot deprecate constructor named the same as the type +{- DEPRECATED WindowBits "Use windowBits. WindowBits constructors will be hidden in version 0.7" -} + +-- | The default 'WindowBits' is 15 which is also the maximum size. +-- +defaultWindowBits :: WindowBits +defaultWindowBits = WindowBits 15 + +-- | A specific compression window size, specified in bits in the range @8..15@ +-- +windowBits :: Int -> WindowBits +windowBits n + | n >= 8 && n <= 15 = WindowBits n + | otherwise = error "WindowBits must be in the range 8..15" + +fromWindowBits :: Format -> WindowBits-> CInt +fromWindowBits format bits = (formatModifier format) (checkWindowBits bits) where checkWindowBits DefaultWindowBits = 15 checkWindowBits (WindowBits n) | n >= 8 && n <= 15 = fromIntegral n @@ -497,6 +608,7 @@ formatModifier GZipOrZlib = (+32) formatModifier Raw = negate + -- | The 'MemoryLevel' parameter specifies how much memory should be allocated -- for the internal compression state. It is a tradoff between memory usage, -- compression ratio and compression speed. Using more memory allows faster @@ -519,13 +631,41 @@ -- to just @32Kb@. -- data MemoryLevel = - DefaultMemoryLevel -- ^ The default. (Equivalent to @'MemoryLevel' 8@) - | MinMemoryLevel -- ^ Use minimum memory. This is slow and reduces the - -- compression ratio. (Equivalent to @'MemoryLevel' 1@) - | MaxMemoryLevel -- ^ Use maximum memory for optimal compression speed. - -- (Equivalent to @'MemoryLevel' 9@) - | MemoryLevel Int -- ^ Use a specific level in the range @1..9@ + DefaultMemoryLevel + | MinMemoryLevel + | MaxMemoryLevel + | MemoryLevel Int +{-# DEPRECATED DefaultMemoryLevel "Use defaultMemoryLevel. MemoryLevel constructors will be hidden in version 0.7" #-} +{-# DEPRECATED MinMemoryLevel "Use minMemoryLevel. MemoryLevel constructors will be hidden in version 0.7" #-} +{-# DEPRECATED MaxMemoryLevel "Use maxMemoryLevel. MemoryLevel constructors will be hidden in version 0.7" #-} +--FIXME: cannot deprecate constructor named the same as the type +{- DEPRECATED MemoryLevel "Use memoryLevel. MemoryLevel constructors will be hidden in version 0.7" -} + +-- | The default memory level. (Equivalent to @'memoryLevel' 8@) +-- +defaultMemoryLevel :: MemoryLevel +defaultMemoryLevel = MemoryLevel 8 + +-- | Use minimum memory. This is slow and reduces the compression ratio. +-- (Equivalent to @'memoryLevel' 1@) +-- +minMemoryLevel :: MemoryLevel +minMemoryLevel = MemoryLevel 1 + +-- | Use maximum memory for optimal compression speed. +-- (Equivalent to @'memoryLevel' 9@) +-- +maxMemoryLevel :: MemoryLevel +maxMemoryLevel = MemoryLevel 9 + +-- | A specific level in the range @1..9@ +-- +memoryLevel :: Int -> MemoryLevel +memoryLevel n + | n >= 1 && n <= 9 = MemoryLevel n + | otherwise = error "MemoryLevel must be in the range 1..9" + fromMemoryLevel :: MemoryLevel -> CInt fromMemoryLevel DefaultMemoryLevel = 8 fromMemoryLevel MinMemoryLevel = 1 @@ -541,17 +681,9 @@ -- correctness of the compressed output even if it is not set appropriately. -- data CompressionStrategy = - DefaultStrategy -- ^ Use the 'DefaultStrategy' for normal data. - | Filtered -- ^ Use 'Filtered' for data produced by a filter (or - -- predictor). Filtered data consists mostly of small - -- values with a somewhat random distribution. In this - -- case, the compression algorithm is tuned to compress - -- them better. The effect of Z_FILTERED is to force more - -- Huffman coding and less string matching; it is - -- somewhat intermediate between 'DefaultStrategy' and - -- 'HuffmanOnly'. - | HuffmanOnly -- ^ Use 'HuffmanOnly' to force Huffman encoding only (no - -- string match). + DefaultStrategy + | Filtered + | HuffmanOnly {- -- -- only available in zlib 1.2 and later, uncomment if you need it. @@ -563,6 +695,32 @@ -- allowing for a simpler decoder for special applications. -} +{-# DEPRECATED DefaultStrategy "Use defaultStrategy. CompressionStrategy constructors will be hidden in version 0.7" #-} +{-# DEPRECATED Filtered "Use filteredStrategy. CompressionStrategy constructors will be hidden in version 0.7" #-} +{-# DEPRECATED HuffmanOnly "Use huffmanOnlyStrategy. CompressionStrategy constructors will be hidden in version 0.7" #-} + +-- | Use this default compression strategy for normal data. +-- +defaultStrategy :: CompressionStrategy +defaultStrategy = DefaultStrategy + +-- | Use the filtered compression strategy for data produced by a filter (or +-- predictor). Filtered data consists mostly of small values with a somewhat +-- random distribution. In this case, the compression algorithm is tuned to +-- compress them better. The effect of this strategy is to force more Huffman +-- coding and less string matching; it is somewhat intermediate between +-- 'defaultCompressionStrategy' and 'huffmanOnlyCompressionStrategy'. +-- +filteredStrategy :: CompressionStrategy +filteredStrategy = Filtered + +-- | Use the Huffman-only compression strategy to force Huffman encoding only +-- (no string match). +-- +huffmanOnlyStrategy :: CompressionStrategy +huffmanOnlyStrategy = HuffmanOnly + + fromCompressionStrategy :: CompressionStrategy -> CInt fromCompressionStrategy DefaultStrategy = #{const Z_DEFAULT_STRATEGY} fromCompressionStrategy Filtered = #{const Z_FILTERED} @@ -570,6 +728,7 @@ --fromCompressionStrategy RLE = #{const Z_RLE} --fromCompressionStrategy Fixed = #{const Z_FIXED} + withStreamPtr :: (Ptr StreamState -> IO a) -> Stream a withStreamPtr f = do stream <- getStreamState @@ -591,8 +750,10 @@ setInNext :: Ptr Word8 -> Stream () setInNext val = withStreamPtr (\ptr -> #{poke z_stream, next_in} ptr val) +#ifdef DEBUG getInNext :: Stream (Ptr Word8) getInNext = withStreamPtr (#{peek z_stream, next_in}) +#endif setOutFree :: Int -> Stream () setOutFree val = withStreamPtr $ \ptr -> @@ -605,14 +766,16 @@ setOutNext :: Ptr Word8 -> Stream () setOutNext val = withStreamPtr (\ptr -> #{poke z_stream, next_out} ptr val) +#ifdef DEBUG getOutNext :: Stream (Ptr Word8) getOutNext = withStreamPtr (#{peek z_stream, next_out}) +#endif inflateInit :: Format -> WindowBits -> Stream () inflateInit format bits = do checkFormatSupported format err <- withStreamState $ \zstream -> - c_inflateInit2 zstream (fromIntegral (windowBits format bits)) + c_inflateInit2 zstream (fromIntegral (fromWindowBits format bits)) failIfError err getStreamState >>= unsafeLiftIO . addForeignPtrFinalizer c_inflateEnd @@ -629,7 +792,7 @@ c_deflateInit2 zstream (fromCompressionLevel compLevel) (fromMethod method) - (windowBits format bits) + (fromWindowBits format bits) (fromMemoryLevel memLevel) (fromCompressionStrategy strategy) failIfError err @@ -639,15 +802,13 @@ inflate_ flush = do err <- withStreamState $ \zstream -> c_inflate zstream (fromFlush flush) - failIfError err - return (toStatus err) + toStatus err deflate_ :: Flush -> Stream Status deflate_ flush = do err <- withStreamState $ \zstream -> c_deflate zstream (fromFlush flush) - failIfError err - return (toStatus err) + toStatus err -- | This never needs to be used as the stream's resources will be released -- automatically when no longer needed, however this can be used to release diff --git a/examples/gunzip.hs b/examples/gunzip.hs new file mode 100644 --- /dev/null +++ b/examples/gunzip.hs @@ -0,0 +1,6 @@ +module Main where + +import qualified Data.ByteString.Lazy as B +import qualified Codec.Compression.GZip as GZip + +main = B.interact GZip.decompress diff --git a/examples/gzip.hs b/examples/gzip.hs new file mode 100644 --- /dev/null +++ b/examples/gzip.hs @@ -0,0 +1,6 @@ +module Main where + +import qualified Data.ByteString.Lazy as B +import qualified Codec.Compression.GZip as GZip + +main = B.interact GZip.compress diff --git a/gunzip.hs b/gunzip.hs deleted file mode 100644 --- a/gunzip.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main where - -import qualified Data.ByteString.Lazy as B -import qualified Codec.Compression.GZip as GZip - -main = B.interact GZip.decompress diff --git a/gzip.hs b/gzip.hs deleted file mode 100644 --- a/gzip.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main where - -import qualified Data.ByteString.Lazy as B -import qualified Codec.Compression.GZip as GZip - -main = B.interact GZip.compress diff --git a/zlib.cabal b/zlib.cabal --- a/zlib.cabal +++ b/zlib.cabal @@ -1,5 +1,5 @@ name: zlib -version: 0.5.0.0 +version: 0.5.2.0 copyright: (c) 2006-2008 Duncan Coutts license: BSD3 license-file: LICENSE @@ -13,7 +13,7 @@ performance. It supports the \"zlib\", \"gzip\" and \"raw\" compression formats. . - It provides a convenient high level api suitable for most + It provides a convenient high level API suitable for most tasks and for the few cases where more control is needed it provides access to the full zlib feature set. stability: provisional @@ -23,7 +23,7 @@ cbits/trees.h cbits/deflate.h cbits/inffixed.h cbits/inftrees.h cbits/zutil.h -- demo programs: - gzip.hs gunzip.hs + examples/gzip.hs examples/gunzip.hs flag bytestring-in-base description: In the ghc-6.6 era the bytestring modules were