packages feed

lzma-streams (empty) → 0.0.0.0

raw patch · 7 files changed

+655/−0 lines, 7 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, bytestring, io-streams, lzma-streams, test-framework, test-framework-hunit, test-framework-quickcheck2

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Herbert Valerio Riedel++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Herbert Valerio Riedel nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/lzma_wrapper.c view
@@ -0,0 +1,65 @@+/*+ * FFI wrappers for `lzma-streams`+ *+ * Copyright (c) 2014, Herbert Valerio Riedel <hvr@gnu.org>+ *+ * This code is BSD3 licensed, see ../LICENSE file for details+ *+ */++#include <stdio.h>+#include <string.h>+#include <lzma.h>+#include <HsFFI.h>++HsInt+hs_lzma_init_decoder(lzma_stream *ls, HsBool autolzma, uint64_t memlimit, uint32_t flags)+{+  /* recommended super-portable initialization */+  const lzma_stream ls_init = LZMA_STREAM_INIT;+  *ls = ls_init;++  const lzma_ret ret = (autolzma ? lzma_auto_decoder : lzma_stream_decoder)(ls, memlimit, flags);++  return ret;+}++HsInt+hs_lzma_init_encoder(lzma_stream *ls, uint32_t preset, HsInt check)+{+  /* recommended super-portable initialization */+  const lzma_stream ls_init = LZMA_STREAM_INIT;+  *ls = ls_init;++  const lzma_ret ret = lzma_easy_encoder(ls, preset, check);++  return ret;+}++void+hs_lzma_done(lzma_stream *ls)+{+  lzma_end(ls);+}++HsInt+hs_lzma_run(lzma_stream *const ls, const HsInt action,+            const uint8_t ibuf[], const HsInt ibuf_len,+            uint8_t obuf[], const HsInt obuf_len)+{+  ls->next_in = ibuf;+  ls->avail_in = ibuf_len;+  ls->next_out = obuf;+  ls->avail_out = obuf_len;++  // paranoia+  memset(obuf, 0, obuf_len);+  +  const lzma_ret ret = lzma_code(ls, action);++  // paranoia+  ls->next_in = NULL;+  ls->next_out = NULL;++  return ret;+}
+ lzma-streams.cabal view
@@ -0,0 +1,65 @@+name:                lzma-streams+version:             0.0.0.0+synopsis:            IO-Streams interface for lzma/xz compression+homepage:            https://github.com/hvr/lzma-streams+bug-reports:         https://github.com/hvr/lzma-streams/issues+license:             BSD3+license-file:        LICENSE+author:              Herbert Valerio Riedel+maintainer:          hvr@gnu.org+stability:           experimental+copyright:           (c) 2015, Herbert Valerio Riedel+category:            Codec, Compression, IO-Streams+build-type:          Simple+cabal-version:       >=1.10+description:+   This package provides an IO-Streams interface for the LZMA+   compression algorithm used in the @.xz@ file format.+   .+   Decompressing @.xz@ 'InputStreams' and compressing 'OutputStreams'+   to @.xz@ with tunable (de)compression parameters is supported.+   .+   See also the XZ Utils home page: <http://tukaani.org/xz/>++source-repository head+  type:     git+  location: https://github.com/hvr/lzma-streams.git++library+  default-language:    Haskell2010+  other-extensions:    RecordWildCards, DeriveDataTypeable++  hs-source-dirs:      src++  exposed-modules:     System.IO.Streams.Lzma+  other-modules:       LibLzma++  includes:            lzma.h+  extra-libraries:     lzma+  c-sources:           cbits/lzma_wrapper.c++  build-depends:       base       >=4.5    && <4.9,+                       bytestring >=0.9.2  && <0.11,+                       io-streams >=1.3    && <1.4++  ghc-options:         -Wall+++test-suite lzma-streams-test+  default-language:    Haskell2010+  hs-source-dirs:      src-tests+  main-is:             lzma-streams-test.hs+  type:                exitcode-stdio-1.0++  build-depends:       base,+                       bytestring,+                       io-streams,+                       lzma-streams,++                       HUnit                      >= 1.2      && <1.3,+                       QuickCheck                 >= 2.8      && <2.9,+                       test-framework             >= 0.8      && <0.9,+                       test-framework-hunit       >= 0.3      && <0.4,+                       test-framework-quickcheck2 >= 0.3      && <0.4++  ghc-options:         -Wall -threaded
+ src-tests/lzma-streams-test.hs view
@@ -0,0 +1,57 @@+import qualified System.IO.Streams.Lzma as LZMA+import qualified System.IO.Streams as Streams+import           Test.Framework+import           Test.Framework.Providers.HUnit+import           Test.Framework.Providers.QuickCheck2+import           Test.HUnit                           hiding (Test)+import qualified Data.ByteString as BS++import System.IO.Unsafe++main :: IO ()+main = defaultMain [ testGroup "System.IO.Streams.Lzma" tests ]+  where+    tests =  [ test0, test1, prop1, prop2 ]++test0 :: Test+test0 = testCase "empty" $ (decode . encode) BS.empty @?= BS.empty++test1 :: Test+test1 = testCase "hello" $ (decode . encode) bs @?= bs+  where+    bs = BS.pack [104,101,108,108,111]++prop1 :: Test+prop1 = testProperty "random" go+  where+    go s = (decode . encode) bs == bs+      where+        bs = BS.pack s++prop2 :: Test+prop2 = testProperty "random-concat" go+  where+    go s s2 = decode (encode bs `BS.append` encode bs2) == bs `BS.append` bs2+      where+        bs  = BS.pack s+        bs2 = BS.pack s2++encode :: BS.ByteString -> BS.ByteString+encode bs = unsafePerformIO $ do+    lst <- Streams.outputToList $ \obs -> do+        ibs  <- Streams.fromByteString bs+        obs' <- LZMA.compress obs+        Streams.connect ibs obs'++    return (BS.concat lst)+{-# NOINLINE encode #-}++decode :: BS.ByteString -> BS.ByteString+decode bs = unsafePerformIO $ do+    lst <- Streams.outputToList $ \obs -> do+        ibs  <- Streams.fromByteString bs+        ibs' <- LZMA.decompress ibs+        Streams.connect ibs' obs++    return (BS.concat lst)+{-# NOINLINE decode #-}
+ src/LibLzma.hsc view
@@ -0,0 +1,282 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable #-}++-- Copyright (c) 2014, Herbert Valerio Riedel <hvr@gnu.org>+--+-- This code is BSD3 licensed, see ../LICENSE file for details+--++-- | Internal low-level binding to liblzma+--+-- TODO: Polish, generalise, and factor out into streaming-API+--       agnostic package w/ minimal build-deps.+--       Something in the style of the incremental API in+--       "Codec.Compression.Zlib.Internal" would be nice+--+module LibLzma+    ( LzmaStream+    , LzmaRet(..)+    , IntegrityCheck(..)+    , CompressionLevel(..)++    , newDecodeLzmaStream+    , DecompressParams(..)+    , defaultDecompressParams++    , newEncodeLzmaStream+    , CompressParams(..)+    , defaultCompressParams++    , runLzmaStream++    , CompressStream(..)+    , compressIO+    ) where++import           Control.Applicative+import           Control.Exception+import           Control.Monad+import           Data.ByteString (ByteString)+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Unsafe as BS+import qualified Data.ByteString as BS+import           Data.Typeable+import           Foreign+import           Prelude++#include <lzma.h>++newtype LzmaStream = LS (ForeignPtr LzmaStream)++data LzmaRet = LzmaRetOK+             | LzmaRetStreamEnd+             | LzmaRetUnsupportedCheck+             | LzmaRetGetCheck+             | LzmaRetMemError+             | LzmaRetMemlimitError+             | LzmaRetFormatError+             | LzmaRetOptionsError+             | LzmaRetDataError+             | LzmaRetBufError+             | LzmaRetProgError+             deriving (Eq,Ord,Show,Typeable)++instance Exception LzmaRet++toLzmaRet :: Int -> Maybe LzmaRet+toLzmaRet i = case i of+    (#const LZMA_OK               ) -> Just LzmaRetOK+    (#const LZMA_STREAM_END       ) -> Just LzmaRetStreamEnd+    (#const LZMA_UNSUPPORTED_CHECK) -> Just LzmaRetUnsupportedCheck+    (#const LZMA_GET_CHECK        ) -> Just LzmaRetGetCheck+    (#const LZMA_MEM_ERROR        ) -> Just LzmaRetMemError+    (#const LZMA_MEMLIMIT_ERROR   ) -> Just LzmaRetMemlimitError+    (#const LZMA_FORMAT_ERROR     ) -> Just LzmaRetFormatError+    (#const LZMA_OPTIONS_ERROR    ) -> Just LzmaRetOptionsError+    (#const LZMA_DATA_ERROR       ) -> Just LzmaRetDataError+    (#const LZMA_BUF_ERROR        ) -> Just LzmaRetBufError+    (#const LZMA_PROG_ERROR       ) -> Just LzmaRetProgError+    _                               -> Nothing++-- | Integrity check type (only supported when compressing @.xz@ files)+data IntegrityCheck = IntegrityCheckNone   -- ^ disable integrity check (not recommended)+               | IntegrityCheckCrc32  -- ^ CRC32 using the polynomial from IEEE-802.3+               | IntegrityCheckCrc64  -- ^ CRC64 using the polynomial from ECMA-182+               | IntegrityCheckSha256 -- ^ SHA-256+               deriving (Eq,Ord,Show)++-- | Compression level presets that define the tradeoff between+-- computational complexity and compression ratio+--+-- 'CompressionLevel0' has the lowest compression ratio as well as the+-- lowest memory requirements, whereas 'CompressionLevel9' has the+-- highest compression ratio and can require over 600MiB during+-- compression (and over 60MiB during decompression). The+-- <https://www.freebsd.org/cgi/man.cgi?query=xz&sektion=1&manpath=FreeBSD+10.2-stable&arch=default&format=html man-page for xz(1)>+-- contains more detailed information with tables describing the+-- properties of all compression level presets.+--+-- 'CompressionLevel6' is the default setting in+-- 'defaultCompressParams' as it provides a good trade-off and+-- matches the default of the @xz(1)@ tool.++data CompressionLevel = CompressionLevel0+                      | CompressionLevel1+                      | CompressionLevel2+                      | CompressionLevel3+                      | CompressionLevel4+                      | CompressionLevel5+                      | CompressionLevel6+                      | CompressionLevel7+                      | CompressionLevel8+                      | CompressionLevel9+                      deriving (Eq,Ord,Show,Enum)++fromIntegrityCheck :: IntegrityCheck -> Int+fromIntegrityCheck lc = case lc of+    IntegrityCheckNone   -> #const LZMA_CHECK_NONE+    IntegrityCheckCrc32  -> #const LZMA_CHECK_CRC32+    IntegrityCheckCrc64  -> #const LZMA_CHECK_CRC64+    IntegrityCheckSha256 -> #const LZMA_CHECK_SHA256++-- | Set of parameters for decompression. The defaults are 'defaultDecompressParams'.+data DecompressParams = DecompressParams+    { decompressTellNoCheck          :: !Bool+    , decompressTellUnsupportedCheck :: !Bool+    , decompressTellAnyCheck         :: !Bool+    , decompressConcatenated         :: !Bool+    , decompressAutoDecoder          :: !Bool+    , decompressMemLimit             :: !Word64 -- ^ Set to 'maxBound' to disable memory limit+    } deriving (Eq,Show)++-- | The default set of parameters for decompression. This is typically used with the decompressWith function with specific parameters overridden.+defaultDecompressParams :: DecompressParams+defaultDecompressParams = DecompressParams {..}+  where+    decompressTellNoCheck          = False+    decompressTellUnsupportedCheck = False+    decompressTellAnyCheck         = False+    decompressConcatenated         = True+    decompressAutoDecoder          = False+    decompressMemLimit             = maxBound -- disables limit-check++-- | Set of parameters for compression. The defaults are 'defaultCompressParams'.+data CompressParams = CompressParams+    { compressIntegrityCheck :: !IntegrityCheck -- ^ Specify type of integrity check+    , compressLevel          :: !CompressionLevel -- ^ See documentation of 'CompressionLevel'+    , compressLevelExtreme   :: !Bool  -- ^ Enable slower variant of the+                                       -- 'lzmaCompLevel' preset, see @xz(1)@+                                       -- man-page for details.+    } deriving (Eq,Show)++-- | The default set of parameters for compression. This is typically used with the compressWith function with specific parameters overridden.+defaultCompressParams :: CompressParams+defaultCompressParams = CompressParams {..}+  where+    compressIntegrityCheck = IntegrityCheckCrc64+    compressLevel          = CompressionLevel6+    compressLevelExtreme   = False++newDecodeLzmaStream :: DecompressParams -> IO (Either LzmaRet LzmaStream)+newDecodeLzmaStream (DecompressParams {..}) = do+    fp <- mallocForeignPtrBytes (#size lzma_stream)+    addForeignPtrFinalizer c_hs_lzma_done_funptr fp+    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_decoder ptr decompressAutoDecoder decompressMemLimit flags')+    rc' <- maybe (fail "newDecodeLzmaStream: invalid return code") pure $ toLzmaRet rc++    return $ case rc' of+        LzmaRetOK -> Right (LS fp)+        _         -> Left rc'+  where+    flags' =+        (if decompressTellNoCheck          then (#const LZMA_TELL_NO_CHECK)          else 0) .|.+        (if decompressTellUnsupportedCheck then (#const LZMA_TELL_UNSUPPORTED_CHECK) else 0) .|.+        (if decompressTellAnyCheck         then (#const LZMA_TELL_ANY_CHECK)         else 0) .|.+        (if decompressConcatenated         then (#const LZMA_CONCATENATED)           else 0)++newEncodeLzmaStream :: CompressParams -> IO (Either LzmaRet LzmaStream)+newEncodeLzmaStream (CompressParams {..}) = do+    fp <- mallocForeignPtrBytes (#size lzma_stream)+    addForeignPtrFinalizer c_hs_lzma_done_funptr fp+    rc <- withForeignPtr fp (\ptr -> c_hs_lzma_init_encoder ptr preset check)+    rc' <- maybe (fail "newDecodeLzmaStream: invalid return code") pure $ toLzmaRet rc++    return $ case rc' of+        LzmaRetOK -> Right (LS fp)+        _         -> Left rc'++  where+    preset = fromIntegral (fromEnum compressLevel) .|.+             (if compressLevelExtreme then (#const LZMA_PRESET_EXTREME) else 0)+    check = fromIntegrityCheck compressIntegrityCheck++runLzmaStream :: LzmaStream -> ByteString -> Bool -> Int -> IO (LzmaRet,Int,ByteString)+runLzmaStream (LS ls) ibs finish buflen+  | buflen <= 0 = fail "runLzmaStream: invalid buflen argument"+  | otherwise = withForeignPtr ls $ \lsptr -> do+      BS.unsafeUseAsCStringLen ibs $ \(ibsptr, ibslen) -> do+          (obuf,rc) <- BS.createAndTrim' buflen $ \bufptr -> do+              rc' <- c_hs_lzma_run lsptr action (castPtr ibsptr) ibslen bufptr buflen+              rc'' <- maybe (fail "runLzmaStream: invalid return code") pure $ toLzmaRet rc'++              availOut <- (#peek lzma_stream, avail_out) lsptr+              unless (buflen >= availOut && availOut >= 0) (fail "runLzmaStream: invalid avail_out")+              let produced = buflen - availOut++              return (0, produced, rc'')++          availIn <- (#peek lzma_stream, avail_in) lsptr+          unless (ibslen >= availIn && availIn >= 0) (fail "runLzmaStream: invalid avail_in")+          let consumed = ibslen - availIn++          return (rc, fromIntegral consumed, obuf)+  where+    action = if finish then (#const LZMA_FINISH) else (#const LZMA_RUN)++----------------------------------------------------------------------------+-- trivial helper wrappers defined in ../cbits/lzma_wrapper.c++foreign import ccall "hs_lzma_init_decoder"+    c_hs_lzma_init_decoder :: Ptr LzmaStream -> Bool -> Word64 -> Word32 -> IO Int++foreign import ccall "hs_lzma_init_encoder"+    c_hs_lzma_init_encoder :: Ptr LzmaStream -> Word32 -> Int -> IO Int++foreign import ccall "hs_lzma_run"+    c_hs_lzma_run :: Ptr LzmaStream -> Int -> Ptr Word8 -> Int -> Ptr Word8 -> Int -> IO Int++foreign import ccall "&hs_lzma_done"+    c_hs_lzma_done_funptr :: FunPtr (Ptr LzmaStream -> IO ())++----------------------------------------------------------------------------++-- type stolen from 'zlib', we may actually just depend on zlib at some point in the future++data CompressStream m =+     CompressInputRequired (ByteString -> m (CompressStream m))+   | CompressOutputAvailable !ByteString (m (CompressStream m))+   | CompressStreamEnd++compressIO :: CompressParams -> IO (CompressStream IO)+compressIO parms = newEncodeLzmaStream parms >>= either throwIO go+  where+    bUFSIZ = 32752++    go :: LzmaStream -> IO (CompressStream IO)+    go ls = return $ CompressInputRequired goInput+      where+        goInput :: ByteString -> IO (CompressStream IO)+        goInput chunk+          | BS.null chunk = goFinish+          | otherwise     = do+              (rc, used, obuf) <- runLzmaStream ls chunk False bUFSIZ++              unless (used > 0) $ fail "compressIO: input chunk not consumed"++              let chunk' = BS.drop used chunk++              case rc of+                  LzmaRetOK+                      | BS.null obuf -> if BS.null chunk'+                                        then return (CompressInputRequired goInput)+                                        else goInput chunk'++                      | otherwise -> return (CompressOutputAvailable obuf+                                             (if BS.null chunk'+                                              then return (CompressInputRequired goInput)+                                              else goInput chunk'))++                  _ -> throwIO rc++        goFinish :: IO (CompressStream IO)+        goFinish = do+            (rc, 0, obuf) <- runLzmaStream ls BS.empty True bUFSIZ++            case rc of+                LzmaRetOK+                    | BS.null obuf -> fail "compressIO: empty output chunk"+                    | otherwise    -> return (CompressOutputAvailable obuf goFinish)+                LzmaRetStreamEnd+                    | BS.null obuf -> return CompressStreamEnd+                    | otherwise    -> return (CompressOutputAvailable obuf (return CompressStreamEnd))++                _ -> throwIO rc
+ src/System/IO/Streams/Lzma.hs view
@@ -0,0 +1,154 @@+-- |+-- Module      : System.IO.Streams.Lzma+-- Copyright   : © 2015 Herbert Valerio Riedel+-- License     : BSD3+--+-- Maintainer  : hvr@gnu.org+-- Stability   : experimental+-- Portability : portable+--+-- Simple IO-Streams interface for lzma/xz compression+--+-- See also the XZ Utils home page: <http://tukaani.org/xz/>+module System.IO.Streams.Lzma+    ( -- * 'ByteString' decompression+      decompress+    , decompressWith+    , defaultDecompressParams+    , DecompressParams(..)++      -- * 'ByteString' compression+    , compress+    , compressWith+    , defaultCompressParams+    , CompressParams(..)+    , IntegrityCheck(..)+    , CompressionLevel(..)++    ) where++import           Control.Exception+import           Control.Monad+import           Data.ByteString   (ByteString)+import qualified Data.ByteString   as BS+import           Data.IORef+import           LibLzma+import           System.IO.Streams (InputStream, OutputStream, makeInputStream,+                                    makeOutputStream)+import qualified System.IO.Streams as Streams++-- | Decompress an 'InputStream' of strict 'ByteString's from the @.xz@ format+decompress :: InputStream ByteString -> IO (InputStream ByteString)+decompress = decompressWith defaultDecompressParams++-- | Like 'decompress' but with the ability to specify various decompression+-- parameters. Typical usage:+--+-- > decompressWith defaultDecompressParams { decompress... = ... }+decompressWith :: DecompressParams -> InputStream ByteString -> IO (InputStream ByteString)+decompressWith flags ibs+    = newDecodeLzmaStream flags >>= either throwIO (wrapLzmaInStream ibs)++-- TODO: figure out sensible buffer-size & refactor into generic+-- incremental API in the style of zlib's incremental API+wrapLzmaInStream :: InputStream ByteString -> LzmaStream -> IO (InputStream ByteString)+wrapLzmaInStream ibs ls0 = do+    st <- newIORef (Right ls0)+    makeInputStream (go st)+  where+    go st = readIORef st >>= either goLeft goRight+      where+        goRight ls = do+            ibuf <- getChunk++            (rc, _, obuf) <- case ibuf of+                Nothing -> runLzmaStream ls BS.empty True bUFSIZ+                Just bs -> do+                    retval@(_, consumed, _) <- runLzmaStream ls bs False bUFSIZ+                    when (consumed < BS.length bs) $ do+                        Streams.unRead (BS.drop consumed bs) ibs+                    return retval++            unless (rc == LzmaRetOK) $ do+                writeIORef st (Left rc)+                unless (rc == LzmaRetStreamEnd) $+                    throwIO rc++            case rc of+                LzmaRetOK -> if (BS.null obuf)+                             then goRight ls -- feed de/encoder some more+                             else return (Just obuf)++                LzmaRetStreamEnd -> do+                    writeIORef st (Left rc)+                    if BS.null obuf+                        then return Nothing+                        else return (Just obuf)++                _ -> writeIORef st (Left rc) >> throwIO rc++    goLeft err = case err of+        LzmaRetStreamEnd -> return Nothing+        _                -> throwIO err++    bUFSIZ = 32752++    -- wrapper around 'read ibs' to retry until a non-empty ByteString or Nothing is returned+    -- TODO: consider implementing flush semantics+    getChunk = do+        mbs <- Streams.read ibs+        case mbs of+            Just bs | BS.null bs -> getChunk+            _                    -> return mbs++----------------------------------------------------------------------------+----------------------------------------------------------------------------++-- | Convert an 'OutputStream' that consumes compressed 'ByteString's+-- (in the @.xz@ format) into an 'OutputStream' that consumes+-- uncompressed 'ByteString's+compress :: OutputStream ByteString -> IO (OutputStream ByteString)+compress = compressWith defaultCompressParams++-- | Like 'compress' but with the ability to specify various compression+-- parameters. Typical usage:+--+-- > compressWith defaultCompressParams { compress... = ... }+compressWith :: CompressParams -> OutputStream ByteString -> IO (OutputStream ByteString)+compressWith parms obs = do+    st <- newIORef =<< compressIO parms+    makeOutputStream (go st)+  where+    go stref (Just chunk)+      | BS.null chunk = return () -- we don't support flushing yet+      | otherwise = do+          st <- readIORef stref+          st' <- case st of+              CompressInputRequired supply -> goOutput =<< supply chunk+              _ -> fail "compressWith: unexpected state"+          writeIORef stref st'++          case st' of+              CompressInputRequired _ -> return ()+              _ -> fail "compressWith:  unexpected state"+++    -- EOF+    go stref Nothing = do+        st <- readIORef stref+        st' <- case st of+            CompressInputRequired supply -> goOutput =<< supply BS.empty+            _ -> fail "compressWith[EOF]: unexpected state"+        writeIORef stref st'+        case st' of+            CompressStreamEnd -> return ()+            _ -> fail "compressWith[EOF]:  unexpected state"++    goOutput st@(CompressInputRequired _) = do+        return st+    goOutput (CompressOutputAvailable obuf next) = do+        Streams.write (Just obuf) obs+        goOutput =<< next+    goOutput st@CompressStreamEnd = do+        Streams.write Nothing obs+        return st