streaming-lzma (empty) → 0.0.0.0
raw patch · 5 files changed
+266/−0 lines, 5 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, bytestring, lzma, streaming, streaming-bytestring, streaming-lzma, test-framework, test-framework-hunit, test-framework-quickcheck2
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- src-tests/test.hs +47/−0
- src/Streaming/Lzma.hs +132/−0
- streaming-lzma.cabal +55/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2019, 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 Ben Gamari 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
+ src-tests/test.hs view
@@ -0,0 +1,47 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main(main) where++import Streaming.Lzma++import qualified Data.ByteString as BS+import qualified Data.ByteString.Streaming as S+import qualified Streaming as S+import qualified Streaming.Prelude as PP++import Test.QuickCheck (Arbitrary (arbitrary), Property,+ counterexample, quickCheck,+ withMaxSuccess)+import Test.QuickCheck.Monadic (assert, monadicIO, monitor, run)++-- | roundtrip without trailing extra data+prop_roundTrip :: [BS.ByteString] -> Property+prop_roundTrip bss = monadicIO $ do+ bss' <- run $ pipeline bss+ monitor $ counterexample $ show bss'+ assert (BS.concat bss' == BS.concat bss)+ where+ pipeline :: S.MonadIO m => [BS.ByteString] -> m [BS.ByteString]+ pipeline = PP.toList_ . S.toChunks . decompress_ . compress . S.fromChunks . PP.each++-- | roundtrip with trailing extra data+prop_roundTrip2 :: [BS.ByteString] -> [BS.ByteString] -> Property+prop_roundTrip2 bss trailer = monadicIO $ do+ (bss',trailer') <- run $ pipeline (bss,trailer)+ monitor $ counterexample $ show (bss',trailer')+ assert ((BS.concat bss', BS.concat trailer') == (BS.concat bss, BS.concat trailer))+ where+ pipeline :: S.MonadIO m => ([BS.ByteString],[BS.ByteString]) -> m ([BS.ByteString],[BS.ByteString])+ pipeline (ibs,itl) = do+ let itls = S.fromChunks . PP.each $ itl+ obs PP.:> tbss <- PP.toList . S.toChunks . decompress . (`S.append` itls) . compress . S.fromChunks . PP.each $ ibs+ tbs <- PP.toList_ . S.toChunks $ tbss+ pure (obs,tbs)++main :: IO ()+main = do+ quickCheck (withMaxSuccess 10000 prop_roundTrip)+ quickCheck (withMaxSuccess 10000 prop_roundTrip2)++instance Arbitrary BS.ByteString where+ arbitrary = BS.pack <$> arbitrary
+ src/Streaming/Lzma.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE Trustworthy #-}++-- |+-- Module : Streaming.Lzma+-- Copyright : © 2019 Herbert Valerio Riedel+--+-- Maintainer : hvr@gnu.org+--+-- Compression and decompression of data streams in the LZMA/XZ format.+--+module Streaming.Lzma+ ( -- * Simple interface+ compress+ , decompress+ , decompress_++ -- * Extended interface+ -- ** Compression+ , compressWith++ , Lzma.defaultCompressParams+ , Lzma.CompressParams++ , Lzma.compressLevel+ , Lzma.CompressionLevel(..)+ , Lzma.compressLevelExtreme+ , Lzma.IntegrityCheck(..)+ , Lzma.compressIntegrityCheck++ -- ** Decompression+ , decompressWith++ , Lzma.defaultDecompressParams+ , Lzma.DecompressParams++ , Lzma.decompressTellNoCheck+ , Lzma.decompressTellUnsupportedCheck+ , Lzma.decompressTellAnyCheck+ , Lzma.decompressConcatenated+ , Lzma.decompressAutoDecoder+ , Lzma.decompressMemLimit++ ) where++import qualified Codec.Compression.Lzma as Lzma+import Control.Exception (throwIO)+import qualified Data.ByteString as B+import Data.ByteString.Streaming (ByteString, chunk, effects,+ nextChunk, null_)+import Streaming (MonadIO (liftIO), lift)++-- | Decompress a compressed LZMA/XZ stream.+--+-- The monadic return value is a stream representing the possibly+-- unconsumed leftover data from the input stream; see also 'decompress_'.+--+-- __NOTE__: 'Lzma.decompressConcatenated' is disabled in this operation+decompress :: MonadIO m+ => ByteString m r -- ^ compressed stream+ -> ByteString m (ByteString m r) -- ^ uncompressed stream+decompress = decompressWith Lzma.defaultDecompressParams { Lzma.decompressConcatenated = False }++-- | Convenience wrapper around 'decompress' which fails eagerly if+-- the compressed stream contains any trailing data+--+-- __NOTE__: 'Lzma.decompressConcatenated' is disabled in this operation+decompress_ :: MonadIO m+ => ByteString m r -- ^ compressed stream+ -> ByteString m r -- ^ uncompressed stream+decompress_ is = do+ mr <- decompress is+ lift $ do+ noLeftovers <- null_ mr+ if noLeftovers+ then effects mr+ else liftIO (throwIO Lzma.LzmaRetStreamEnd)++-- | Like 'decompress' but with the ability to specify various decompression+-- parameters. Typical usage:+--+-- __NOTE__: Be aware that 'Lzma.decompressConcatenated' is enabled by default in 'Lzma.defaultDecompressParams'.+--+-- > decompressWith defaultDecompressParams { decompress... = ... }+decompressWith :: MonadIO m+ => Lzma.DecompressParams+ -> ByteString m r -- ^ compressed stream+ -> ByteString m (ByteString m r) -- ^ uncompressed stream+decompressWith params stream0 =+ go stream0 =<< liftIO (Lzma.decompressIO params)+ where+ go stream enc@(Lzma.DecompressInputRequired cont) = do+ lift (nextChunk stream) >>= \case+ Right (ibs,stream')+ | B.null ibs -> go stream' enc -- should not happen+ | otherwise -> go stream' =<< liftIO (cont ibs)+ Left r -> go (pure r) =<< liftIO (cont B.empty)+ go stream (Lzma.DecompressOutputAvailable obs cont) = do+ chunk obs+ go stream =<< liftIO cont+ go stream (Lzma.DecompressStreamEnd leftover) =+ pure (chunk leftover >> stream)+ go _stream (Lzma.DecompressStreamError ecode) =+ liftIO (throwIO ecode)++-- | Compress into a LZMA/XZ compressed stream.+compress :: MonadIO m+ => ByteString m r -- ^ compressed stream+ -> ByteString m r -- ^ uncompressed stream+compress = compressWith Lzma.defaultCompressParams++-- | Like 'compress' but with the ability to specify various compression+-- parameters. Typical usage:+--+-- > compressWith defaultCompressParams { compress... = ... }+compressWith :: MonadIO m+ => Lzma.CompressParams+ -> ByteString m r -- ^ uncompressed stream+ -> ByteString m r -- ^ compressed stream+compressWith params stream0 =+ go stream0 =<< liftIO (Lzma.compressIO params)+ where+ go stream enc@(Lzma.CompressInputRequired _flush cont) = do+ lift (nextChunk stream) >>= \case+ Right (x, stream')+ | B.null x -> go stream' enc -- should not happen+ | otherwise -> go stream' =<< liftIO (cont x)+ Left r -> go (pure r) =<< liftIO (cont B.empty)+ go stream (Lzma.CompressOutputAvailable obs cont) = do+ chunk obs+ go stream =<< liftIO cont+ go stream Lzma.CompressStreamEnd = stream
+ streaming-lzma.cabal view
@@ -0,0 +1,55 @@+cabal-version: 1.12+build-type: Simple+name: streaming-lzma+version: 0.0.0.0++synopsis: Streaming interface for LZMA/XZ compression+homepage: https://github.com/hvr/streaming-lzma+bug-reports: https://github.com/hvr/streaming-lzma/issues+license: BSD3+license-file: LICENSE+author: Herbert Valerio Riedel+maintainer: hvr@gnu.org+category: Codec, Compression, Streaming++description:+ This package provides a <http://hackage.haskell.org/package/streaming streaming> API for the <https://en.wikipedia.org/wiki/LZMA LZMA (Lempel–Ziv–Markov chain algorithm)> compression algorithm used in the @.xz@ file format.++source-repository head+ type: git+ location: https://github.com/hvr/streaming-lzma.git++library+ default-language: Haskell2010+ other-extensions: Trustworthy LambdaCase++ hs-source-dirs: src+ exposed-modules: Streaming.Lzma++ build-depends: base >= 4.8 && < 4.13+ , bytestring >= 0.10.6 && < 0.11+ , lzma == 0.0.*+ , streaming-bytestring >= 0.1.6 && < 0.2+ , streaming == 0.2.*++ ghc-options: -Wall++test-suite test+ default-language: Haskell2010+ hs-source-dirs: src-tests+ main-is: test.hs+ type: exitcode-stdio-1.0++ build-depends: base+ , bytestring+ , streaming+ , streaming-lzma+ , streaming-bytestring++ , HUnit == 1.6.*+ , QuickCheck == 2.13.*+ , test-framework == 0.8.*+ , test-framework-hunit == 0.3.*+ , test-framework-quickcheck2 == 0.3.*++ ghc-options: -Wall -threaded