diff --git a/lzma.cabal b/lzma.cabal --- a/lzma.cabal +++ b/lzma.cabal @@ -1,5 +1,5 @@ name: lzma -version: 0.0.0.1 +version: 0.0.0.2 synopsis: LZMA/XZ compression and decompression homepage: https://github.com/hvr/lzma bug-reports: https://github.com/hvr/lzma/issues @@ -12,18 +12,22 @@ category: Codec, Compression build-type: Simple cabal-version: >=1.10 -tested-with: GHC ==7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.1 +tested-with: GHC ==7.4.2, GHC ==7.6.3, GHC ==7.8.4, GHC ==7.10.3, GHC ==8.0.1 description: This package provides a pure interface for compressing and - decompressing streams of data represented as lazy @ByteString@s. A + decompressing + + streams of data represented as lazy @ByteString@s. A monadic incremental interface is provided as well. This package - relies on the @liblzma@ C library. + relies on the . . The following packages are based on this package and provide API support for popular streaming frameworks: . * (for ) . + * (for ) + . source-repository head type: git @@ -31,13 +35,13 @@ library default-language: Haskell2010 - other-extensions: RecordWildCards, DeriveDataTypeable + other-extensions: BangPatterns, RecordWildCards, DeriveDataTypeable hs-source-dirs: src exposed-modules: Codec.Compression.Lzma other-modules: LibLzma - build-depends: base >=4.5 && <4.9 + build-depends: base >=4.5 && <4.10 , bytestring >=0.9.2 && <0.11 if os(windows) @@ -63,9 +67,9 @@ , base , bytestring -- additional dependencies that require version bounds - build-depends: HUnit >= 1.2 && <1.3 + build-depends: HUnit >= 1.2 && <1.4 , QuickCheck >= 2.8 && <2.9 - , tasty == 0.10.* + , tasty >= 0.10 && <0.12 , tasty-hunit == 0.9.* , tasty-quickcheck >= 0.8.3.2 && < 0.9 diff --git a/src-tests/lzma-tests.hs b/src-tests/lzma-tests.hs --- a/src-tests/lzma-tests.hs +++ b/src-tests/lzma-tests.hs @@ -69,9 +69,8 @@ , testCase "decode-sample" $ decompress samplexz @?= sampleref , testCase "decode-sample2" $ decompress (singletonChunked samplexz) @?= sampleref , testCase "encode-sample" $ codecompress sampleref @?= sampleref - , testCase "encode-empty^50" $ (iterate decompress (iterate compress "" !! 50) !! 50) @?= "" + , testCase "encode-empty^50" $ (iterate decompress (iterate (compressWith lowProf) "" !! 50) !! 50) @?= "" , testCase "encode-10MiB-zeros" $ let z = BL.replicate (10*1024*1024) 0 in codecompress z @?= z - ] properties = testGroup "properties" @@ -84,6 +83,8 @@ , QC.testProperty "decompress . (compress a <> compress b) === a <> b" $ \(RandBLSm a) (RandBLSm b) -> decompress (compress a `mappend` compress b) == a `mappend` b ] + + lowProf = defaultCompressParams { compressLevel = CompressionLevel0 } nullxz :: BL.ByteString nullxz = BL.pack [253,55,122,88,90,0,0,4,230,214,180,70,0,0,0,0,28,223,68,33,31,182,243,125,1,0,0,0,0,4,89,90] diff --git a/src/Codec/Compression/Lzma.hs b/src/Codec/Compression/Lzma.hs --- a/src/Codec/Compression/Lzma.hs +++ b/src/Codec/Compression/Lzma.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE BangPatterns #-} + -- | -- Module : Codec.Compression.Lzma -- Copyright : © 2015 Herbert Valerio Riedel @@ -173,7 +175,7 @@ goFlush, goFinish :: IO (CompressStream IO) goFlush = goSync LzmaSyncFlush (return inputRequired) - goFinish = goSync LzmaFinish (return CompressStreamEnd) + goFinish = goSync LzmaFinish retStreamEnd -- drain encoder till LzmaRetStreamEnd is reported goSync :: LzmaAction -> IO (CompressStream IO) -> IO (CompressStream IO) @@ -191,6 +193,10 @@ | otherwise -> return (CompressOutputAvailable obuf next) _ -> throwIO rc + retStreamEnd = do + !() <- stToIO (endLzmaStream ls) + return CompressStreamEnd + -- | Incremental compression in the lazy 'ST' monad. compressST :: CompressParams -> ST s (CompressStream (ST s)) compressST parms = strictToLazyST (newEncodeLzmaStream parms) >>= either throw go @@ -220,7 +226,7 @@ goFlush, goFinish :: ST s (CompressStream (ST s)) goFlush = goSync LzmaSyncFlush (return inputRequired) - goFinish = goSync LzmaFinish (return CompressStreamEnd) + goFinish = goSync LzmaFinish retStreamEnd -- drain encoder till LzmaRetStreamEnd is reported goSync :: LzmaAction -> ST s (CompressStream (ST s)) -> ST s (CompressStream (ST s)) @@ -238,6 +244,10 @@ | otherwise -> return (CompressOutputAvailable obuf next) _ -> throw rc + retStreamEnd = do + !() <- strictToLazyST (endLzmaStream ls) + return CompressStreamEnd + -------------------------------------------------------------------------------- data DecompressStream m = @@ -275,13 +285,12 @@ (withChunk goDrain goInput chunk')) LzmaRetStreamEnd - | BS.null obuf -> return (DecompressStreamEnd chunk') + | BS.null obuf -> retStreamEnd chunk' | otherwise -> return (DecompressOutputAvailable obuf - (return (DecompressStreamEnd chunk'))) + (retStreamEnd chunk')) _ -> return (DecompressStreamError rc) - goDrain, goFinish :: IO (DecompressStream IO) goDrain = goSync LzmaRun (return inputRequired) goFinish = goSync LzmaFinish (return $ DecompressStreamError LzmaRetOK) @@ -302,8 +311,11 @@ _ -> return (DecompressStreamError rc) - eof0 = return $ DecompressStreamEnd BS.empty + eof0 = retStreamEnd BS.empty + retStreamEnd chunk' = do + !() <- stToIO (endLzmaStream ls) + return (DecompressStreamEnd chunk') -- | Incremental decompression in the lazy 'ST' monad. decompressST :: DecompressParams -> ST s (DecompressStream (ST s)) @@ -334,9 +346,9 @@ (withChunk goDrain goInput chunk')) LzmaRetStreamEnd - | BS.null obuf -> return (DecompressStreamEnd chunk') + | BS.null obuf -> retStreamEnd chunk' | otherwise -> return (DecompressOutputAvailable obuf - (return (DecompressStreamEnd chunk'))) + (retStreamEnd chunk')) _ -> return (DecompressStreamError rc) @@ -361,8 +373,11 @@ _ -> return (DecompressStreamError rc) - eof0 = return $ DecompressStreamEnd BS.empty + eof0 = retStreamEnd BS.empty + retStreamEnd chunk' = do + !() <- strictToLazyST (endLzmaStream ls) + return (DecompressStreamEnd chunk') -- | Small 'maybe'-ish helper distinguishing between empty and -- non-empty 'ByteString's diff --git a/src/LibLzma.hsc b/src/LibLzma.hsc --- a/src/LibLzma.hsc +++ b/src/LibLzma.hsc @@ -24,6 +24,7 @@ , defaultCompressParams , runLzmaStream + , endLzmaStream , LzmaAction(..) ) where @@ -226,6 +227,13 @@ LzmaSyncFlush -> #const LZMA_SYNC_FLUSH LzmaFullFlush -> #const LZMA_FULL_FLUSH LzmaFinish -> #const LZMA_FINISH + + +-- | Force immediate finalization of 'ForeignPtr' associated with +-- 'LzmaStream'. This triggers a call to @lzma_end()@, therefore it's +-- a programming error to call 'runLzmaStream' afterwards. +endLzmaStream :: LzmaStream -> ST s () +endLzmaStream (LS ls) = unsafeIOToST $ finalizeForeignPtr ls ---------------------------------------------------------------------------- -- trivial helper wrappers defined in ../cbits/lzma_wrapper.c