Hello, I have written patch (attached) which introduce new API for zlib - personally I wrote it to have easy implementation of compression/decompression in iteratee (example file - no yet working -attached).
Earlier version of patch I tried to sent to maintainer of zlib. However I received no response (possibly I get into spam folder by helpful spamassassin or something like that). I definitely don't want to fork this library - especially that it is in haskell platform. What should I do with the patch? Regards
1 patch for repository http://code.haskell.org/zlib: Fri Mar 26 00:37:13 GMT 2010 Maciej Piechotka <[email protected]> * Add iterator API. New patches: [Add iterator API. Maciej Piechotka <[email protected]>**20100326003713 Ignore-this: b30ae5167f65c82e3c5bb0af37ffbf70 ] { hunk ./Codec/Compression/Zlib/Internal.hs 57 decompressWithErrors, DecompressStream(..), DecompressError(..), + -- * Low-level iterator API + Output(..), + CompressState, + startCompress, + iterCompress, + finishCompress, + DecompressState, + startDecompress, + iterDecompress, + finishDecompress, ) where import Prelude hiding (length) hunk ./Codec/Compression/Zlib/Internal.hs 70 -import Control.Monad (when) +import Control.Monad (when,liftM) import Control.Exception (assert) import qualified Data.ByteString.Lazy as L #ifdef BYTESTRING_IN_BASE hunk ./Codec/Compression/Zlib/Internal.hs 76 import qualified Data.ByteString.Base as S #else +import qualified Data.ByteString as S import qualified Data.ByteString.Lazy.Internal as L import qualified Data.ByteString.Internal as S #endif hunk ./Codec/Compression/Zlib/Internal.hs 435 return (StreamChunk (S.PS outFPtr offset length) end) else do Stream.finalise return end + +data CompressState = CompressState Int Stream.ZState + + +startCompress :: Stream.Format -> CompressParams -> IO CompressState +startCompress format (CompressParams lvl mth bits mem str bufSize) = do + state <- Stream.newZState + (_, state') <- Stream.runZ state $ + Stream.deflateInit format lvl mth bits mem str >> + Stream.unsafeLiftIO (S.mallocByteString bufSize) >>= \p -> + Stream.pushOutputBuffer p 0 bufSize + return $! CompressState bufSize state' + + +iterCompress :: S.ByteString + -> CompressState + -> IO (Output CompressState) +iterCompress (S.PS p o l) (CompressState bufSize state) = do + (bs, state') <- Stream.runZ state $ + Stream.pushInputBuffer p o l >> + getOutputString (Stream.deflate Stream.NoFlush) bufSize + return $! (const $ CompressState bufSize state') `fmap` bs + + +finishCompress :: CompressState -> IO (Output ()) +finishCompress (CompressState bufSize state) = do + (bs, _) <- Stream.runZ state $ + getOutputString (Stream.deflate Stream.Finish) bufSize + return $! error "No EOF on EOF" `fmap` bs + +data DecompressState = DecompressState Int Stream.ZState + +startDecompress :: Stream.Format -> DecompressParams -> IO DecompressState +startDecompress format (DecompressParams bits bufSize) = do + state <- Stream.newZState + (_, state') <- Stream.runZ state $ + Stream.inflateInit format bits >> + Stream.unsafeLiftIO (S.mallocByteString bufSize) >>= \p -> + Stream.pushOutputBuffer p 0 bufSize + return $! DecompressState bufSize state' + + +iterDecompress :: S.ByteString + -> DecompressState + -> IO (Output DecompressState) +iterDecompress (S.PS p o l) (DecompressState bufSize state) = do + (bs, state') <- Stream.runZ state $ + Stream.pushInputBuffer p o l >> + getOutputString (Stream.inflate Stream.NoFlush) bufSize + return $! (const $ DecompressState bufSize state') `fmap` bs + + +finishDecompress :: DecompressState -> IO (Output ()) +finishDecompress (DecompressState bufSize state) = do + (bs, _) <- Stream.runZ state $ + getOutputString (Stream.inflate Stream.Finish) bufSize + return $! error "No EOF on EOF" `fmap` bs + +data Output a = Ok L.ByteString a + | EOF S.ByteString L.ByteString + | Error S.ByteString L.ByteString (Stream.ErrorCode, String) + +instance Functor Output where + f `fmap` (Ok a b) = Ok a (f b) + _ `fmap` (EOF e a) = EOF e a + _ `fmap` (Error e a er) = Error e a er + +joinOS :: S.ByteString -> Output a -> Output a +s `joinOS` (Ok a b) = Ok (s `L.chunk` a) b +s `joinOS` (EOF e a) = EOF e (s `L.chunk` a) +s `joinOS` (Error e a er) = Error e (s `L.chunk` a) er + +getOutputString :: Stream Stream.Status + -> Int + -> Stream (Output ()) +getOutputString func bufSize = do + status <- func + case status of + Stream.Ok -> do + full <- Stream.outputBufferFull + if full + then do (p, o, l) <- Stream.popOutputBuffer + p' <- Stream.unsafeLiftIO (S.mallocByteString bufSize) + Stream.pushOutputBuffer p' 0 bufSize + rest <- getOutputString func bufSize + return $! S.PS p o l `joinOS` rest + else return $! Ok L.Empty () + Stream.StreamEnd -> do + avail <- Stream.outputBufferBytesAvailable + out <- if avail /= 0 + then (\(p, o, l) -> S.PS p o l) `liftM` Stream.popOutputBuffer + else return $! S.empty + empty <- Stream.inputBufferEmpty + in_ <- if empty + then (\(p, o, l) -> S.PS p o l) `liftM` Stream.getInputBuffer + else return $! S.empty + return $! EOF in_ (out `L.chunk` L.Empty) + Stream.Error code msg -> do + avail <- Stream.outputBufferBytesAvailable + out <- if avail /= 0 + then (\(p, o, l) -> S.PS p o l) `liftM` Stream.popOutputBuffer + else return $! S.empty + empty <- Stream.inputBufferEmpty + in_ <- if empty + then (\(p, o, l) -> S.PS p o l) `liftM` Stream.getInputBuffer + else return $! S.empty + return $! Error in_ (out `L.chunk` L.Empty) (code, msg) hunk ./Codec/Compression/Zlib/Stream.hsc 18 -- * The Zlib state monad Stream, + ZState, + newZState, run, hunk ./Codec/Compression/Zlib/Stream.hsc 21 + runZ, unsafeInterleave, unsafeLiftIO, finalise, hunk ./Codec/Compression/Zlib/Stream.hsc 67 -- * Buffer management -- ** Input buffer pushInputBuffer, + getInputBuffer, inputBufferEmpty, -- ** Output buffer hunk ./Codec/Compression/Zlib/Stream.hsc 87 ) where import Foreign - ( Word8, Ptr, nullPtr, plusPtr, peekByteOff, pokeByteOff, mallocBytes - , ForeignPtr, FinalizerPtr, newForeignPtr_, addForeignPtrFinalizer - , finalizeForeignPtr, withForeignPtr, touchForeignPtr - , unsafeForeignPtrToPtr, unsafePerformIO ) + ( Word8, Ptr, nullPtr, plusPtr, minusPtr, peekByteOff, pokeByteOff, + mallocBytes, ForeignPtr, FinalizerPtr, newForeignPtr_, + addForeignPtrFinalizer, finalizeForeignPtr, withForeignPtr, + touchForeignPtr, unsafeForeignPtrToPtr, unsafePerformIO ) import Foreign.C ( CInt, CUInt, CChar, CString, withCAString, peekCAString ) #ifdef BYTESTRING_IN_BASE hunk ./Codec/Compression/Zlib/Stream.hsc 131 -- 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. +getInputBuffer :: Stream (ForeignPtr Word8, Int, Int) +getInputBuffer = do + length <- getInAvail + Z $ \state inBuf outBuf outOffset outLength -> do + withForeignPtr state $ \state' -> do + realIn <- (#peek z_stream, next_in) state' + offset <- withForeignPtr inBuf $ \inBuf' -> + return $! realIn `minusPtr` inBuf' + return $! (inBuf, outBuf, outOffset, outLength, (inBuf, offset, length)) inputBufferEmpty :: Stream Bool inputBufferEmpty = getInAvail >>= return . (==0) hunk ./Codec/Compression/Zlib/Stream.hsc 293 failZ :: String -> Stream a failZ msg = Z (\_ _ _ _ _ -> fail ("Codec.Compression.Zlib: " ++ msg)) -{-# NOINLINE run #-} -run :: Stream a -> a -run (Z m) = unsafePerformIO $ do +data ZState = ZState (ForeignPtr StreamState) (ForeignPtr Word8) (ForeignPtr Word8) Int Int + +newZState :: IO (ZState) +newZState = do ptr <- mallocBytes (#{const sizeof(z_stream)}) #{poke z_stream, msg} ptr nullPtr #{poke z_stream, zalloc} ptr nullPtr hunk ./Codec/Compression/Zlib/Stream.hsc 307 #{poke z_stream, avail_in} ptr (0 :: CUInt) #{poke z_stream, avail_out} ptr (0 :: CUInt) stream <- newForeignPtr_ ptr - (_,_,_,_,a) <- m stream nullForeignPtr nullForeignPtr 0 0 - return a + return $! ZState stream nullForeignPtr nullForeignPtr 0 0 + +runZ :: ZState -> Stream a -> IO (a, ZState) +runZ (ZState s i o a b) (Z m) = + (\(i', o', a', b', v) -> (v, ZState s i' o' a' b')) `fmap` m s i o a b + +{-# NOINLINE run #-} +run :: Stream a -> a +run z = unsafePerformIO (fst `fmap` (flip runZ z =<< newZState)) -- This is marked as unsafe because run uses unsafePerformIO so anything -- lifted here will end up being unsafePerformIO'd. } Context: [TAG 0.5.2.0 Duncan Coutts <[email protected]>**20090623142900] [Bump version to 0.5.2.0 Duncan Coutts <[email protected]>**20090623142845] [Fix warnings in test code Duncan Coutts <[email protected]>**20090623141004] [Change name of test file Duncan Coutts <[email protected]>**20090623140843 The .gz file contains two compressed files back to back. The gzip program can handle these but our code cannot. So do not call it a .gz file otherwise our test scripts pick it up. ] [ifdef out debugging code Duncan Coutts <[email protected]>**20090623135615] [Add a couple more tests and fix location of examples Duncan Coutts <[email protected]>**20090623135505] [Make the compress/decompress wrappers use the "With" variants Duncan Coutts <[email protected]>**20090623134044] [Adjust test scripts to give less verbose output Duncan Coutts <[email protected]>**20090623015434] [Make tests mostly -Wall clean Duncan Coutts <[email protected]>**20090623013255] [Add HUnit tests for specific conditions Duncan Coutts <[email protected]>**20090623012711 Specifically, check for: .gz files with a bad crc (like darcs) detection of non compressed files detection of compressed files with a custom dictionary ] [Adjust the Arbitrary instance for lazy bytestrings Duncan Coutts <[email protected]>**20090623012150 Make multi-chunk lazy bytestrings. This improves our code coverage. ] [Add a truncation property Duncan Coutts <[email protected]>**20090623012050 Check that we can always correctly detect when a compressed data stream is truncated. ] [Rearrange code in the main test module Duncan Coutts <[email protected]>**20090623011724 And add type sigs. ] [Improve the test makefile Duncan Coutts <[email protected]>**20090623011358] [Use the new parameter constructors in the tests Duncan Coutts <[email protected]>**20090623011322] [Make the fields strict in the (De)compressParams data records Duncan Coutts <[email protected]>**20090621230820] [Use and export the compression param smart constructors Duncan Coutts <[email protected]>**20090621230543] [Add smart constructors for the compression param types Duncan Coutts <[email protected]>**20090621230131 Deprecate the constructors. The reason for the change is to make the numeric params more regular. Currently we've got DefaultMemoryLevel and MemoryLevel Int but really these overlap. It's more sensible to have defaultMemoryLevel = MemoryLevel 8 so that they compare equal. ] [add Makefile as test driver Ganesh Sittampalam <[email protected]>**20090615205245] [add shell-based tests Ganesh Sittampalam <[email protected]>**20090615205235] [add comment Ganesh Sittampalam <[email protected]>**20090615180202] [add zpipe example Ganesh Sittampalam <[email protected]>**20090615054951] [make examples dir for gzip/gunzip Ganesh Sittampalam <[email protected]>**20090615054903] [import sample client from zlib library Ganesh Sittampalam <[email protected]>**20090614204502 Ignore-this: a9e2f039672df3cd01c66464334777f5 ] [Move the QC instances into separate modules Duncan Coutts <[email protected]>**20090614204908 So the the package as a whole doesn't depend on QC. ] [add instances for QuickCheck Ganesh Sittampalam <[email protected]>**20090602070506] [update test precondition based on observation Ganesh Sittampalam <[email protected]>**20090602182056] [add some basic tests using test-framework Ganesh Sittampalam <[email protected]>**20090602070608] [fix doc typo Ganesh Sittampalam <[email protected]>**20090602054924] [Change internals to return data errors explicitly Duncan Coutts <[email protected]>**20090529201824 Based on an original patch by Ganesh Sittampalam <[email protected]> The point is that callers that are interested in the errors can now see and manipulate them as values rather than just getting calls to error. In particular this should allow darcs to read old files that have incorrect data checksums. ] [add comment Ganesh Sittampalam <[email protected]>**20090505105314] [delete NOINLINE pragmas that have no explanation Ganesh Sittampalam <[email protected]>**20090419111552] [Fix "api" to "API" in description in .cabal file Duncan Coutts <[email protected]>**20090324120544 Apparently it's a debian package lint warning! :-) I'm glad they take these things seriously. ] [TAG 0.5.0.0 Duncan Coutts <[email protected]>**20081101183832] Patch bundle hash: b3ce15f49428695d1c05a2fd6219cfb11841ca8c
{-# LANGUAGE ScopedTypeVariables #-}
import Codec.Compression.Zlib.Internal as Z
import Control.Applicative
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as L
import Data.Iteratee as I
import Data.Iteratee.Base.StreamChunk as SC
import Data.Iteratee.WrappedByteString
import Data.ListLike as LL hiding (putStrLn)
import Data.Maybe
compress :: Format -> CompressParams
-> EnumeratorGMM WrappedByteString e' WrappedByteString e' IO a
compress f cp iter = do
cs <- startCompress f cp
return $! iterZLib cs iterCompress finishCompress iter
decompress :: Format -> DecompressParams
-> EnumeratorGMM WrappedByteString e' WrappedByteString e' IO a
decompress f cp iter = do
cs <- startDecompress f cp
return $! iterZLib cs iterDecompress finishDecompress iter
iterZLib :: s
-> (S.ByteString -> s -> IO (Output s))
-> (s -> IO (Output ()))
-> IterateeG WrappedByteString e IO a
-> IterateeG WrappedByteString e' IO a
iterZLib s i f iter =
let iterZLib' (I.Chunk c) = iterZLib'' =<< i (unWrap c) s
iterZLib' (I.EOF err) = iterZLib''' =<< f s
iterZLib'' (Z.Ok out s') = do
iter' <- runLazyIter out iter
return $! Cont (iterZLib s i f iter') Nothing
iterZLib'' e = iterZLib'''' e
iterZLib''' (Z.Ok out s') =
let e = Err "Impossible happened"
in return $! Cont (throwErr e) (Just e)
iterZLib''' e = iterZLib'''' e
iterZLib'''' (Z.EOF res out) = do
enumEof' (WrapBS res) =<< runLazyIter out iter
iterZLib'''' (Z.Error res out (_, msg)) = do
enumErr' msg (WrapBS res) =<< runLazyIter out iter
in IterateeG $! iterZLib'
runLazyIter :: Monad m => L.ByteString -> EnumeratorGM WrappedByteString el m a
runLazyIter (L.Chunk cur next) iter = do
res <- runIter iter (Chunk (WrapBS cur))
case res of
Done v _ -> return (skipToEof >> return v)
Cont iter' _ -> return $! iter'
runLazyIter (L.Empty) iter = return $! iter
enumEof' :: (Monad m, Functor m) => s' e' -> IterateeG s e m a -> m (IterGV s' e' m a)
enumEof' res iter = check <$> runIter iter (I.EOF Nothing)
where check (Done x _) = Done x (Chunk res)
check (Cont _ e) = let e' = fromMaybe (Err "Divergent Iteratee") e
in Cont (throwErr e') (Just e')
enumErr' :: (Monad m, Functor m) => String -> s' e' -> IterateeG s e m a -> m (IterGV s' e' m a)
enumErr' e res iter = check <$> runIter iter (I.EOF (Just (Err e)))
where check (Done x _) = Done x (Chunk res)
check (Cont _ e') = let e'' = fromMaybe (Err "Divergent Iteratee") e'
in Cont (throwErr e'') (Just e'')
instance Show (WrappedByteString a) where
show = show . unWrap
printIter :: (Show (s e), ListLike (s e) item) => IterateeG s e IO ()
printIter = IterateeG $! printIter'
where printIter' (I.Chunk c) =
putStrLn ("Received: <" ++ show c ++ ">") >>
return (Cont printIter Nothing)
printIter' (I.EOF _) =
putStrLn ("EOF") >> return (Done () $! Chunk LL.empty)
signature.asc
Description: This is a digitally signed message part
_______________________________________________ Haskell-Cafe mailing list [email protected] http://www.haskell.org/mailman/listinfo/haskell-cafe
