diff --git a/Codec/Compression/BZip.hs b/Codec/Compression/BZip.hs
new file mode 100644
--- /dev/null
+++ b/Codec/Compression/BZip.hs
@@ -0,0 +1,88 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright : (c) 2006 Duncan Coutts
+-- License : BSD-style
+--
+-- Maintainer : duncan.coutts@worc.ox.ac.uk
+-- Stability : experimental
+-- Portability : portable (H98 + FFI)
+--
+-- Compression and decompression of data streams in the bzip2 format.
+--
+-- bzip2 is a freely available, patent free, high-quality data compressor. It
+-- typically compresses files to within 10% to 15% of the best available
+-- techniques (the PPM family of statistical compressors), whilst being around
+-- twice as fast at compression and six times faster at decompression.
+--
+--
+--
+-----------------------------------------------------------------------------
+module Codec.Compression.BZip (
+
+ -- | This module provides pure functions for compressing and decompressing
+ -- streams of data represented by lazy 'ByteString's. This makes it easy to
+ -- use either in memory or with disk or network IO.
+ --
+ -- For example a simple bzip compression program is just:
+ --
+ -- > import qualified Data.ByteString.Lazy as ByteString
+ -- > import qualified Codec.Compression.BZip as BZip
+ -- >
+ -- > main = ByteString.interact BZip.compress
+ --
+ -- Or you could lazily read in and decompress a @.bz2@ file using:
+ --
+ -- > content <- fmap BZip.decompress (readFile file)
+ --
+
+ -- * Compression
+ compress,
+ compressWith,
+ BlockSize(..),
+
+ -- * Decompression
+ decompress
+
+ ) where
+
+import Data.ByteString.Lazy (ByteString)
+
+import Codec.Compression.BZip.Internal as Internal
+
+
+-- | Decompress a stream of data in the bzip2 format.
+--
+-- There are a number of errors that can occur. In each case an exception will
+-- be thrown. The possible error conditions are:
+--
+-- * if the stream does not start with a valid gzip header
+--
+-- * if the compressed stream is corrupted
+--
+-- * if the compressed stream ends permaturely
+--
+-- Note that the decompression is performed /lazily/. Errors in the data stream
+-- may not be detected until the end of the stream is demanded (since it is
+-- only at the end that the final checksum can be checked). If this is
+-- important to you, you must make sure to consume the whole decompressed
+-- stream before doing any IO action that depends on it.
+--
+decompress :: ByteString -> ByteString
+decompress = Internal.decompressDefault
+
+
+-- | Compress a stream of data into the bzip2 format.
+--
+-- This uses the default compression level which uses the largest compression
+-- block size for the highest compression level. Use 'compressWith' to adjust
+-- the compression block size.
+--
+compress :: ByteString -> ByteString
+compress = Internal.compressDefault DefaultBlockSize
+
+
+-- | Like 'compress' but with an extra parameter to specify the block size
+-- used for compression.
+--
+compressWith :: BlockSize -> ByteString -> ByteString
+compressWith = Internal.compressDefault
diff --git a/Codec/Compression/BZip/Internal.hs b/Codec/Compression/BZip/Internal.hs
new file mode 100644
--- /dev/null
+++ b/Codec/Compression/BZip/Internal.hs
@@ -0,0 +1,237 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright : (c) 2006 Duncan Coutts
+-- License : BSD-style
+--
+-- Maintainer : duncan.coutts@worc.ox.ac.uk
+-- Stability : experimental
+-- Portability : portable (H98 + FFI)
+--
+-- Pure stream based interface to lower level bzlib wrapper
+--
+-----------------------------------------------------------------------------
+module Codec.Compression.BZip.Internal (
+
+ -- * Compression and decompression
+ compressDefault,
+ decompressDefault,
+ Stream.BlockSize(..),
+
+ -- * The same but with the full set of parameters
+ compressFull,
+ decompressFull,
+ Stream.WorkFactor(..),
+ Stream.MemoryLevel(..),
+ Stream.Verbosity(..),
+
+ ) where
+
+import Prelude hiding (length)
+import Control.Monad (liftM, when)
+import Control.Exception (assert)
+import qualified Data.ByteString.Lazy as Lazy
+import qualified Data.ByteString as Strict
+import qualified Data.ByteString.Base as Base
+import Data.ByteString.Base (LazyByteString(LPS))
+
+import qualified Codec.Compression.BZip.Stream as Stream
+import Codec.Compression.BZip.Stream (Stream)
+
+compressDefault
+ :: Stream.BlockSize
+ -> Lazy.ByteString
+ -> Lazy.ByteString
+compressDefault blockSize =
+ compressFull blockSize
+ Stream.Silent
+ Stream.DefaultWorkFactor
+
+decompressDefault
+ :: Lazy.ByteString
+ -> Lazy.ByteString
+decompressDefault =
+ decompressFull Stream.Silent
+ Stream.DefaultMemoryLevel
+
+{-# NOINLINE compressFull #-}
+compressFull
+ :: Stream.BlockSize
+ -> Stream.Verbosity
+ -> Stream.WorkFactor
+ -> Lazy.ByteString
+ -> Lazy.ByteString
+
+compressFull blockSize verbosity workFactor (LPS chunks) =
+ Stream.run $ do
+ Stream.compressInit blockSize verbosity workFactor
+ case chunks of
+ [] -> liftM LPS (fillBuffers [])
+ (Base.PS inFPtr offset length : chunks') -> do
+ Stream.pushInputBuffer inFPtr offset length
+ liftM LPS (fillBuffers chunks')
+
+ where
+ outChunkSize :: Int
+ outChunkSize = 32 * 1024 - 16
+
+ -- we flick between two states:
+ -- * where one or other buffer is empty
+ -- - in which case we refill one or both
+ -- * where both buffers are non-empty
+ -- - in which case we compress until a buffer is empty
+
+ fillBuffers ::
+ [Strict.ByteString]
+ -> Stream [Strict.ByteString]
+ fillBuffers inChunks = do
+ Stream.consistencyCheck
+
+ -- in this state there are two possabilities:
+ -- * no outbut buffer space is available
+ -- - in which case we must make more available
+ -- * no input buffer is available
+ -- - in which case we must supply more
+ inputBufferEmpty <- Stream.inputBufferEmpty
+ outputBufferFull <- Stream.outputBufferFull
+
+ assert (inputBufferEmpty || outputBufferFull) $ return ()
+
+ when outputBufferFull $ do
+ outFPtr <- Stream.unsafeLiftIO (Base.mallocByteString outChunkSize)
+ Stream.pushOutputBuffer outFPtr 0 outChunkSize
+
+ if inputBufferEmpty
+ then case inChunks of
+ [] -> drainBuffers []
+ (Base.PS inFPtr offset length : inChunks') -> do
+ Stream.pushInputBuffer inFPtr offset length
+ drainBuffers inChunks'
+ else drainBuffers inChunks
+
+
+ drainBuffers ::
+ [Strict.ByteString]
+ -> Stream [Strict.ByteString]
+ drainBuffers inChunks = do
+
+ inputBufferEmpty' <- Stream.inputBufferEmpty
+ outputBufferFull' <- Stream.outputBufferFull
+ assert(not outputBufferFull'
+ && (null inChunks || not inputBufferEmpty')) $ return ()
+ -- this invariant guarantees we can always make forward progress
+
+ let action = if null inChunks then Stream.Finish else Stream.Run
+ status <- Stream.compress action
+
+ case status of
+ Stream.Ok -> do
+ outputBufferFull <- Stream.outputBufferFull
+ if outputBufferFull
+ then do (outFPtr, offset, length) <- Stream.popOutputBuffer
+ outChunks <- Stream.unsafeInterleave (fillBuffers inChunks)
+ return (Base.PS outFPtr offset length : outChunks)
+ else do fillBuffers inChunks
+
+ Stream.StreamEnd -> do
+ inputBufferEmpty <- Stream.inputBufferEmpty
+ assert inputBufferEmpty $ return ()
+ outputBufferBytesAvailable <- Stream.outputBufferBytesAvailable
+ if outputBufferBytesAvailable > 0
+ then do (outFPtr, offset, length) <- Stream.popOutputBuffer
+ Stream.finalise
+ return (Base.PS outFPtr offset length : [])
+ else do Stream.finalise
+ return []
+
+
+{-# NOINLINE decompressFull #-}
+decompressFull
+ :: Stream.Verbosity
+ -> Stream.MemoryLevel
+ -> Lazy.ByteString
+ -> Lazy.ByteString
+decompressFull verbosity memLevel (LPS chunks) =
+ Stream.run $ do
+ Stream.decompressInit verbosity memLevel
+ case chunks of
+ [] -> liftM LPS (fillBuffers [])
+ (Base.PS inFPtr offset length : chunks') -> do
+ Stream.pushInputBuffer inFPtr offset length
+ liftM LPS (fillBuffers chunks')
+
+ where
+ outChunkSize :: Int
+ outChunkSize = 32 * 1024 - 16
+
+ -- we flick between two states:
+ -- * where one or other buffer is empty
+ -- - in which case we refill one or both
+ -- * where both buffers are non-empty
+ -- - in which case we compress until a buffer is empty
+
+ fillBuffers ::
+ [Strict.ByteString]
+ -> Stream [Strict.ByteString]
+ fillBuffers inChunks = do
+
+ -- in this state there are two possabilities:
+ -- * no outbut buffer space is available
+ -- - in which case we must make more available
+ -- * no input buffer is available
+ -- - in which case we must supply more
+ inputBufferEmpty <- Stream.inputBufferEmpty
+ outputBufferFull <- Stream.outputBufferFull
+
+ assert (inputBufferEmpty || outputBufferFull) $ return ()
+
+ when outputBufferFull $ do
+ outFPtr <- Stream.unsafeLiftIO (Base.mallocByteString outChunkSize)
+ Stream.pushOutputBuffer outFPtr 0 outChunkSize
+
+ if inputBufferEmpty
+ then case inChunks of
+ [] -> drainBuffers []
+ (Base.PS inFPtr offset length : inChunks') -> do
+ Stream.pushInputBuffer inFPtr offset length
+ drainBuffers inChunks'
+ else drainBuffers inChunks
+
+
+ drainBuffers ::
+ [Strict.ByteString]
+ -> Stream [Strict.ByteString]
+ drainBuffers inChunks = do
+
+ inputBufferEmpty' <- Stream.inputBufferEmpty
+ outputBufferFull' <- Stream.outputBufferFull
+ assert(not outputBufferFull'
+ && (null inChunks || not inputBufferEmpty')) $ return ()
+ -- this invariant guarantees we can always make forward progress or at
+ -- least detect premature EOF
+
+ status <- Stream.decompress
+
+ case status of
+ Stream.Ok -> do
+ outputBufferFull <- Stream.outputBufferFull
+ if outputBufferFull
+ then do (outFPtr, offset, length) <- Stream.popOutputBuffer
+ outChunks <- Stream.unsafeInterleave (fillBuffers inChunks)
+ return (Base.PS outFPtr offset length : outChunks)
+ else do -- We need to detect if we ran out of input:
+ inputBufferEmpty <- Stream.inputBufferEmpty
+ if inputBufferEmpty && null inChunks
+ then fail "premature end of compressed stream"
+ else fillBuffers 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 (Base.PS outFPtr offset length : [])
+ else do Stream.finalise
+ return []
diff --git a/Codec/Compression/BZip/Stream.hsc b/Codec/Compression/BZip/Stream.hsc
new file mode 100644
--- /dev/null
+++ b/Codec/Compression/BZip/Stream.hsc
@@ -0,0 +1,592 @@
+-----------------------------------------------------------------------------
+-- |
+-- Copyright : (c) 2006 Duncan Coutts
+-- License : BSD-style
+--
+-- Maintainer : duncan.coutts@worc.ox.ac.uk
+-- Stability : experimental
+-- Portability : portable (H98 + FFI)
+--
+-- BZlib wrapper layer
+--
+-----------------------------------------------------------------------------
+module Codec.Compression.BZip.Stream (
+
+ -- * The Zlib state monad
+ Stream,
+ run,
+ unsafeInterleave,
+ unsafeLiftIO,
+ finalise,
+
+ -- * Initialisation
+ compressInit,
+ decompressInit,
+
+ -- ** Initialisation parameters
+ BlockSize(..),
+ WorkFactor(..),
+ MemoryLevel(..),
+ Verbosity(..),
+
+ -- * The buisness
+ compress,
+ decompress,
+ Status(..),
+ Action(..),
+
+ -- * Buffer management
+ -- ** Input buffer
+ pushInputBuffer,
+ inputBufferEmpty,
+
+ -- ** Output buffer
+ pushOutputBuffer,
+ popOutputBuffer,
+ outputBufferBytesAvailable,
+ outputBufferSpaceRemaining,
+ outputBufferFull,
+
+ -- * Debugging
+ consistencyCheck,
+ dump,
+ trace,
+
+ ) where
+
+import Foreign
+import Foreign.C
+import Data.ByteString.Base
+import System.IO.Unsafe (unsafeInterleaveIO)
+import System.IO (hPutStrLn, stderr)
+import Control.Monad (liftM)
+import Control.Exception (assert)
+
+import Prelude hiding (length)
+
+#include
+
+
+pushInputBuffer :: ForeignPtr Word8 -> Int -> Int -> Stream ()
+pushInputBuffer inBuf' offset length = do
+
+ -- must not push a new input buffer if the last one is not used up
+ inAvail <- getInAvail
+ assert (inAvail == 0) $ return ()
+
+ -- Now that we're setting a new input buffer, we can be sure that zlib no
+ -- longer has a reference to the old one. Therefore this is the last point
+ -- at which the old buffer had to be retained. It's safe to release now.
+ inBuf <- getInBuf
+ unsafeLiftIO $ touchForeignPtr inBuf
+
+ -- now set the available input buffer ptr and length
+ setInBuf inBuf'
+ setInAvail length
+ setInNext (unsafeForeignPtrToPtr inBuf' `plusPtr` offset)
+ -- Note the 'unsafe'. We are passing the raw ptr inside inBuf' to zlib.
+ -- To make this safe we need to hold on to the ForeignPtr for at least as
+ -- long as zlib is using the underlying raw ptr.
+
+
+inputBufferEmpty :: Stream Bool
+inputBufferEmpty = getInAvail >>= return . (==0)
+
+
+pushOutputBuffer :: ForeignPtr Word8 -> Int -> Int -> Stream ()
+pushOutputBuffer outBuf' offset length = do
+
+ --must not push a new buffer if there is still data in the old one
+ outAvail <- getOutAvail
+ assert (outAvail == 0) $ return ()
+ -- Note that there may still be free space in the output buffer, that's ok,
+ -- you might not want to bother completely filling the output buffer say if
+ -- there's only a few free bytes left.
+
+ outBuf <- getOutBuf
+ unsafeLiftIO $ touchForeignPtr outBuf
+
+ -- now set the available input buffer ptr and length
+ setOutBuf outBuf'
+ setOutFree length
+ setOutNext (unsafeForeignPtrToPtr outBuf' `plusPtr` offset)
+
+ setOutOffset offset
+ setOutAvail 0
+
+
+-- get that part of the output buffer that is currently full
+-- (might be 0, use outputBufferBytesAvailable to check)
+-- this may leave some space remaining in the buffer, use
+-- outputBufferSpaceRemaining to check.
+popOutputBuffer :: Stream (ForeignPtr Word8, Int, Int)
+popOutputBuffer = do
+
+ outBuf <- getOutBuf
+ outOffset <- getOutOffset
+ outAvail <- getOutAvail
+
+ -- there really should be something to pop, otherwise it's silly
+ assert (outAvail > 0) $ return ()
+
+ setOutOffset (outOffset + outAvail)
+ setOutAvail 0
+
+ return (outBuf, outOffset, outAvail)
+
+
+-- this is the number of bytes available in the output buffer
+outputBufferBytesAvailable :: Stream Int
+outputBufferBytesAvailable = getOutAvail
+
+
+-- you needen't get all the output immediately, you can continue until
+-- there is no more output space available, this tells you that amount
+outputBufferSpaceRemaining :: Stream Int
+outputBufferSpaceRemaining = getOutFree
+
+
+-- you only need to supply a new buffer when there is no more output buffer
+-- space remaining
+outputBufferFull :: Stream Bool
+outputBufferFull = getOutFree >>= return . (==0)
+
+
+-- you can only run this when the output buffer is not empty
+-- you can run it when the input buffer is empty but it doesn't do anything
+-- after running deflate either the output buffer will be full
+-- or the input buffer will be empty (or both)
+compress :: Action -> Stream Status
+compress action = do
+
+ outFree <- getOutFree
+
+ -- deflate needs free space in the output buffer
+ assert (outFree > 0) $ return ()
+
+ result <- compress_ action
+ outFree' <- getOutFree
+
+ -- number of bytes of extra output there is available as a result of
+ -- the call to deflate:
+ let outExtra = outFree - outFree'
+
+ outAvail <- getOutAvail
+ setOutAvail (outAvail + outExtra)
+ return result
+
+
+decompress :: Stream Status
+decompress = do
+
+ outFree <- getOutFree
+
+ -- inflate needs free space in the output buffer
+ assert (outFree > 0) $ return ()
+
+ result <- decompress_
+ outFree' <- getOutFree
+
+ -- number of bytes of extra output there is available as a result of
+ -- the call to inflate:
+ let outExtra = outFree - outFree'
+
+ outAvail <- getOutAvail
+ setOutAvail (outAvail + outExtra)
+ return result
+
+
+----------------------------
+-- Stream monad
+--
+
+newtype Stream a = BZ {
+ unZ :: ForeignPtr StreamState
+ -> ForeignPtr Word8
+ -> ForeignPtr Word8
+ -> Int -> Int
+ -> IO (ForeignPtr Word8
+ ,ForeignPtr Word8
+ ,Int, Int, a)
+ }
+
+instance Monad Stream where
+ (>>=) = thenZ
+-- m >>= f = (m `thenZ` \a -> consistencyCheck `thenZ_` returnZ a) `thenZ` f
+ (>>) = thenZ_
+ return = returnZ
+ fail = (finalise >>) . failZ
+
+returnZ :: a -> Stream a
+returnZ a = BZ $ \_ inBuf outBuf outOffset outLength ->
+ return (inBuf, outBuf, outOffset, outLength, a)
+{-# INLINE returnZ #-}
+
+thenZ :: Stream a -> (a -> Stream b) -> Stream b
+thenZ (BZ m) f =
+ BZ $ \stream inBuf outBuf outOffset outLength ->
+ m stream inBuf outBuf outOffset outLength >>=
+ \(inBuf', outBuf', outOffset', outLength', a) ->
+ unZ (f a) stream inBuf' outBuf' outOffset' outLength'
+{-# INLINE thenZ #-}
+
+thenZ_ :: Stream a -> Stream b -> Stream b
+thenZ_ (BZ m) f =
+ BZ $ \stream inBuf outBuf outOffset outLength ->
+ m stream inBuf outBuf outOffset outLength >>=
+ \(inBuf', outBuf', outOffset', outLength', _) ->
+ unZ f stream inBuf' outBuf' outOffset' outLength'
+{-# INLINE thenZ_ #-}
+
+failZ :: String -> Stream a
+failZ msg = BZ (\_ _ _ _ _ -> fail ("Codec.Compression.BZip: " ++ msg))
+
+{-# NOINLINE run #-}
+run :: Stream a -> a
+run (BZ m) = unsafePerformIO $ do
+ ptr <- mallocBytes (#{const sizeof(bz_stream)})
+ #{poke bz_stream, avail_in} ptr (0 :: CUInt)
+ #{poke bz_stream, next_in} ptr nullPtr
+ #{poke bz_stream, avail_out} ptr (0 :: CUInt)
+ #{poke bz_stream, next_out} ptr nullPtr
+ #{poke bz_stream, bzalloc} ptr nullPtr
+ #{poke bz_stream, bzfree} ptr nullPtr
+ #{poke bz_stream, opaque} ptr nullPtr
+ stream <- newForeignPtr_ ptr
+ (_,_,_,_,a) <- m stream nullForeignPtr nullForeignPtr 0 0
+ return a
+
+unsafeLiftIO :: IO a -> Stream a
+unsafeLiftIO m = BZ $ \_stream inBuf outBuf outOffset outLength -> do
+ a <- m
+ return (inBuf, outBuf, outOffset, outLength, a)
+
+-- It's unsafe because we discard the values here, so if you mutate anything
+-- between running this and forcing the result then you'll get an inconsistent
+-- stream state.
+unsafeInterleave :: Stream a -> Stream a
+unsafeInterleave (BZ m) = BZ $ \stream inBuf outBuf outOffset outLength -> do
+ res <- unsafeInterleaveIO (m stream inBuf outBuf outOffset outLength)
+ let select (_,_,_,_,a) = a
+ return (inBuf, outBuf, outOffset, outLength, select res)
+
+getStreamState :: Stream (ForeignPtr StreamState)
+getStreamState = BZ $ \stream inBuf outBuf outOffset outLength -> do
+ return (inBuf, outBuf, outOffset, outLength, stream)
+
+getInBuf :: Stream (ForeignPtr Word8)
+getInBuf = BZ $ \_stream inBuf outBuf outOffset outLength -> do
+ return (inBuf, outBuf, outOffset, outLength, inBuf)
+
+getOutBuf :: Stream (ForeignPtr Word8)
+getOutBuf = BZ $ \_stream inBuf outBuf outOffset outLength -> do
+ return (inBuf, outBuf, outOffset, outLength, outBuf)
+
+getOutOffset :: Stream Int
+getOutOffset = BZ $ \_stream inBuf outBuf outOffset outLength -> do
+ return (inBuf, outBuf, outOffset, outLength, outOffset)
+
+getOutAvail :: Stream Int
+getOutAvail = BZ $ \_stream inBuf outBuf outOffset outLength -> do
+ return (inBuf, outBuf, outOffset, outLength, outLength)
+
+setInBuf :: ForeignPtr Word8 -> Stream ()
+setInBuf inBuf = BZ $ \_stream _ outBuf outOffset outLength -> do
+ return (inBuf, outBuf, outOffset, outLength, ())
+
+setOutBuf :: ForeignPtr Word8 -> Stream ()
+setOutBuf outBuf = BZ $ \_stream inBuf _ outOffset outLength -> do
+ return (inBuf, outBuf, outOffset, outLength, ())
+
+setOutOffset :: Int -> Stream ()
+setOutOffset outOffset = BZ $ \_stream inBuf outBuf _ outLength -> do
+ return (inBuf, outBuf, outOffset, outLength, ())
+
+setOutAvail :: Int -> Stream ()
+setOutAvail outLength = BZ $ \_stream inBuf outBuf outOffset _ -> do
+ return (inBuf, outBuf, outOffset, outLength, ())
+
+----------------------------
+-- Debug stuff
+--
+
+trace :: String -> Stream ()
+trace = unsafeLiftIO . hPutStrLn stderr
+
+dump :: Stream ()
+dump = do
+ inNext <- getInNext
+ inAvail <- getInAvail
+
+ outNext <- getOutNext
+ outFree <- getOutFree
+ outAvail <- getOutAvail
+ outOffset <- getOutOffset
+
+ unsafeLiftIO $ hPutStrLn stderr $
+ "Stream {\n" ++
+ " inNext = " ++ show inNext ++ ",\n" ++
+ " inAvail = " ++ show inAvail ++ ",\n" ++
+ "\n" ++
+ " outNext = " ++ show outNext ++ ",\n" ++
+ " outFree = " ++ show outFree ++ ",\n" ++
+ " outAvail = " ++ show outAvail ++ ",\n" ++
+ " outOffset = " ++ show outOffset ++ "\n" ++
+ "}"
+
+ consistencyCheck
+
+consistencyCheck :: Stream ()
+consistencyCheck = do
+
+ outBuf <- getOutBuf
+ outOffset <- getOutOffset
+ outAvail <- getOutAvail
+ outNext <- getOutNext
+
+ let outBufPtr = unsafeForeignPtrToPtr outBuf
+
+ assert (outBufPtr `plusPtr` (outOffset + outAvail) == outNext) $ return ()
+
+
+----------------------------
+-- zlib wrapper layer
+--
+
+data Status =
+ Ok -- ^ The requested action was completed successfully.
+ | StreamEnd -- ^ Compression of data was completed, or the logical stream
+ -- end was detected during decompression.
+
+instance Enum Status where
+ toEnum (#{const BZ_OK}) = Ok
+ toEnum (#{const BZ_RUN_OK}) = Ok
+ toEnum (#{const BZ_FLUSH_OK}) = Ok
+ toEnum (#{const BZ_FINISH_OK}) = Ok
+ toEnum (#{const BZ_STREAM_END}) = StreamEnd
+ toEnum other = error ("unexpected bzip2 status: " ++ show other)
+
+isFatalError :: CInt -> Bool
+isFatalError n | n >= 0 = False
+isFatalError _ = True
+
+throwError :: CInt -> Stream a
+throwError (#{const BZ_SEQUENCE_ERROR})
+ = fail "incorrect sequence of calls"
+throwError (#{const BZ_PARAM_ERROR})
+ = fail "incorrect parameter"
+throwError (#{const BZ_MEM_ERROR})
+ = fail "not enough memory"
+throwError (#{const BZ_DATA_ERROR})
+ = fail "compressed data stream is corrupt"
+throwError (#{const BZ_DATA_ERROR_MAGIC})
+ = fail "data stream is not a bzip2 file"
+throwError (#{const BZ_CONFIG_ERROR})
+ = fail "configuration error in bzip2 lib"
+throwError other
+ = fail ("unknown or impossible error code: " ++ show other)
+
+data Action =
+ Run
+ | Flush
+ | Finish
+
+instance Enum Action where
+ fromEnum Run = #{const BZ_RUN}
+ fromEnum Flush = #{const BZ_FLUSH}
+ fromEnum Finish = #{const BZ_FINISH}
+
+-- | The block size affects both the compression ratio achieved, and the amount
+-- of memory needed for compression and decompression.
+--
+-- @'BlockSize' 1@ through @'BlockSize' 9@ specify the block size to be 100,000
+-- bytes through 900,000 bytes respectively. The default is to use the maximum
+-- block size.
+--
+-- Larger block sizes give rapidly diminishing marginal returns. Most of the
+-- compression comes from the first two or three hundred k of block size, a
+-- fact worth bearing in mind when using bzip2 on small machines. It is also
+-- important to appreciate that the decompression memory requirement is set at
+-- compression time by the choice of block size.
+--
+-- * In general, try and use the largest block size memory constraints allow,
+-- since that maximises the compression achieved.
+--
+-- * Compression and decompression speed are virtually unaffected by block
+-- size.
+--
+-- Another significant point applies to files which fit in a single block -
+-- that means most files you'd encounter using a large block size. The amount
+-- of real memory touched is proportional to the size of the file, since the
+-- file is smaller than a block. For example, compressing a file 20,000 bytes
+-- long with the flag @'BlockSize' 9@ will cause the compressor to allocate
+-- around 7600k of memory, but only touch 400k + 20000 * 8 = 560 kbytes of it.
+-- Similarly, the decompressor will allocate 3700k but only touch 100k + 20000
+-- * 4 = 180 kbytes.
+--
+data BlockSize =
+ DefaultBlockSize -- ^ The default block size is also the maximum.
+ | BlockSize Int -- ^ A specific block size between 1 and 9.
+
+instance Enum BlockSize where
+ fromEnum DefaultBlockSize = 9
+ fromEnum (BlockSize n)
+ | n >= 1 && n <= 9 = n
+ | otherwise = error "BlockSize must be in the range 1..9"
+
+-- | For files compressed with the default 900k block size, decompression will
+-- require about 3700k to decompress. To support decompression of any file in
+-- less than 4Mb there is the option to decompress using approximately half
+-- this amount of memory, about 2300k. Decompression speed is also halved,
+-- so you should use this option only where necessary.
+--
+data MemoryLevel =
+ DefaultMemoryLevel -- ^ The default.
+ | MinMemoryLevel -- ^ Use minimum memory dusing decompression. This
+ -- halves the memory needed but also halves the
+ -- decompression speed.
+
+instance Enum MemoryLevel where
+ fromEnum DefaultMemoryLevel = 0
+ fromEnum MinMemoryLevel = 1
+
+-- | The 'WorkFactor' parameter controls how the compression phase behaves when
+-- presented with worst case, highly repetitive, input data. If compression
+-- runs into difficulties caused by repetitive data, the library switches from
+-- the standard sorting algorithm to a fallback algorithm. The fallback is
+-- slower than the standard algorithm by perhaps a factor of three, but always
+-- behaves reasonably, no matter how bad the input.
+--
+-- Lower values of 'WorkFactor' reduce the amount of effort the standard
+-- algorithm will expend before resorting to the fallback. You should set this
+-- parameter carefully; too low, and many inputs will be handled by the
+-- fallback algorithm and so compress rather slowly, too high, and your
+-- average-to-worst case compression times can become very large. The default
+-- value of 30 gives reasonable behaviour over a wide range of circumstances.
+--
+-- * Note that the compressed output generated is the same regardless of
+-- whether or not the fallback algorithm is used.
+--
+data WorkFactor =
+ DefaultWorkFactor -- ^ The default work factor is 30.
+ | WorkFactor Int -- ^ Allowable values range from 1 to 250 inclusive.
+
+instance Enum WorkFactor where
+ fromEnum DefaultWorkFactor = 0
+ fromEnum (WorkFactor n)
+ | n >= 1 && n <= 250 = n
+ | otherwise = error "WorkFactor must be in the range 1..250"
+
+-- | The 'Verbosity' parameter is a number between 0 and 4. 0 is silent, and
+-- greater numbers give increasingly verbose monitoring\/debugging output.
+--
+data Verbosity = Silent -- ^ No output. This is the default.
+ | Verbosity Int -- ^ A specific level between 0 and 4.
+
+instance Enum Verbosity where
+ fromEnum Silent = 0
+ fromEnum (Verbosity n)
+ | n >= 0 && n <= 4 = n
+ | otherwise = error "Verbosity must be in the range 0..4"
+
+withStreamPtr :: (Ptr StreamState -> IO a) -> Stream a
+withStreamPtr f = do
+ stream <- getStreamState
+ unsafeLiftIO (withForeignPtr stream f)
+
+setInAvail :: Int -> Stream ()
+setInAvail val = withStreamPtr $ \ptr ->
+ #{poke bz_stream, avail_in} ptr (fromIntegral val :: CUInt)
+
+getInAvail :: Stream Int
+getInAvail = liftM (fromIntegral :: CUInt -> Int) $
+ withStreamPtr (#{peek bz_stream, avail_in})
+
+setInNext :: Ptr Word8 -> Stream ()
+setInNext val = withStreamPtr (\ptr -> #{poke bz_stream, next_in} ptr val)
+
+getInNext :: Stream (Ptr Word8)
+getInNext = withStreamPtr (#{peek bz_stream, next_in})
+
+setOutFree :: Int -> Stream ()
+setOutFree val = withStreamPtr $ \ptr ->
+ #{poke bz_stream, avail_out} ptr (fromIntegral val :: CUInt)
+
+getOutFree :: Stream Int
+getOutFree = liftM (fromIntegral :: CUInt -> Int) $
+ withStreamPtr (#{peek bz_stream, avail_out})
+
+setOutNext :: Ptr Word8 -> Stream ()
+setOutNext val = withStreamPtr (\ptr -> #{poke bz_stream, next_out} ptr val)
+
+getOutNext :: Stream (Ptr Word8)
+getOutNext = withStreamPtr (#{peek bz_stream, next_out})
+
+decompressInit :: Verbosity -> MemoryLevel -> Stream ()
+decompressInit verbosity memoryLevel = do
+ err <- withStreamPtr $ \ptr ->
+ bzDecompressInit ptr
+ (fromIntegral (fromEnum verbosity))
+ (fromIntegral (fromEnum memoryLevel))
+ if isFatalError err
+ then throwError err
+ else do stream <- getStreamState
+ unsafeLiftIO $ addForeignPtrFinalizer bzDecompressEnd stream
+
+compressInit :: BlockSize -> Verbosity -> WorkFactor -> Stream ()
+compressInit blockSize verbosity workFactor = do
+ err <- withStreamPtr $ \ptr ->
+ bzCompressInit ptr
+ (fromIntegral (fromEnum blockSize))
+ (fromIntegral (fromEnum verbosity))
+ (fromIntegral (fromEnum workFactor))
+ if isFatalError err
+ then throwError err
+ else do stream <- getStreamState
+ unsafeLiftIO $ addForeignPtrFinalizer bzCompressEnd stream
+
+decompress_ :: Stream Status
+decompress_ = do
+ err <- withStreamPtr (\ptr -> bzDecompress ptr)
+ if isFatalError err
+ then throwError err
+ else return (toEnum (fromIntegral err))
+
+compress_ :: Action -> Stream Status
+compress_ action = do
+ err <- withStreamPtr (\ptr -> bzCompress ptr (fromIntegral (fromEnum action)))
+ if isFatalError err
+ then throwError err
+ else return (toEnum (fromIntegral 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
+-- them early. Only use this when you can guarantee that the stream will no
+-- longer be needed, for example if an error occurs or if the stream ends.
+--
+finalise :: Stream ()
+finalise = getStreamState >>= unsafeLiftIO . finalizeForeignPtr
+
+----------------------
+-- The foreign imports
+
+data StreamState = StreamState ()
+
+foreign import ccall unsafe "bzlib.h BZ2_bzDecompressInit"
+ bzDecompressInit :: Ptr StreamState -> CInt -> CInt -> IO CInt
+
+foreign import ccall unsafe "bzlib.h BZ2_bzDecompress"
+ bzDecompress :: Ptr StreamState -> IO CInt
+
+foreign import ccall unsafe "bzlib.h &BZ2_bzDecompressEnd"
+ bzDecompressEnd :: FinalizerPtr StreamState
+
+
+foreign import ccall unsafe "bzlib.h BZ2_bzCompressInit"
+ bzCompressInit :: Ptr StreamState -> CInt -> CInt -> CInt -> IO CInt
+
+foreign import ccall unsafe "bzlib.h BZ2_bzCompress"
+ bzCompress :: Ptr StreamState -> CInt -> IO CInt
+
+foreign import ccall unsafe "bzlib.h &BZ2_bzCompressEnd"
+ bzCompressEnd :: FinalizerPtr StreamState
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bzlib.cabal b/bzlib.cabal
new file mode 100644
--- /dev/null
+++ b/bzlib.cabal
@@ -0,0 +1,15 @@
+name: bzlib
+version: 0.2
+copyright: (c) 2006 Duncan Coutts
+build-depends: base, fps
+license: BSD3
+author: Duncan Coutts
+maintainer: Duncan Coutts
+synopsis: Compression and decompression in the bzip2 format
+exposed-modules: Codec.Compression.BZip,
+ Codec.Compression.BZip.Internal
+other-modules: Codec.Compression.BZip.Stream
+extensions: ForeignFunctionInterface
+includes: bzlib.h
+extra-libraries: bz2
+ghc-options: -fvia-C -Wall