lzlib 0.2.0.2 → 0.3.0.0
raw patch · 7 files changed
+84/−43 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- README.md +5/−1
- bench/Bench.hs +14/−11
- lzlib.cabal +1/−1
- src/Codec/Lzip.hs +54/−24
- stack.yaml +1/−1
- test/Spec.hs +4/−5
CHANGELOG.md view
@@ -1,5 +1,10 @@ # lzlib +## 0.3.0.0++ * Take a `BSL.ByteString` as input+ * Performance improvements+ ## 0.2.0.2 * Performance improvements
README.md view
@@ -1,8 +1,12 @@ # lzlib +[](https://matrix.hackage.haskell.org/package/lzlib)+[](http://hackage.haskell.org/package/lzlib)+[](https://hackage.haskell.org/package/lzlib)+ Haskell bindings to [lzlib](https://www.nongnu.org/lzip/lzlib.html). -## Building+## Hacking Run
bench/Bench.hs view
@@ -2,32 +2,33 @@ import Codec.Lzip import Criterion.Main-import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory) -roundtrip :: BS.ByteString -> BSL.ByteString-roundtrip = compress . BSL.toStrict . decompress+roundtrip :: BSL.ByteString -> BSL.ByteString+roundtrip = compress . decompress -roundtrip' :: BS.ByteString -> BSL.ByteString-roundtrip' = decompress . BSL.toStrict . compress+roundtrip' :: BSL.ByteString -> BSL.ByteString+roundtrip' = decompress . compress unpack :: IO () unpack = withSystemTempDirectory "lzlib" $ \fp -> BSL.writeFile (fp </> "lzlib.tar.lz") =<<- (roundtrip <$> BS.readFile "lzlib-1.10.tar.lz")+ (roundtrip <$> BSL.readFile "lzlib-1.10.tar.lz") unpack' :: IO () unpack' = withSystemTempDirectory "lzlib" $ \fp -> BSL.writeFile (fp </> "lzlib.tar") =<<- (roundtrip' <$> BS.readFile "lzlib-1.10.tar")+ (roundtrip' <$> BSL.readFile "lzlib-1.10.tar") main :: IO () main =- defaultMain [ env file $ \ f ->+ defaultMain [ env files $ \ ~(f, g) -> bgroup "roundtrip"- [ bench "lzlib" $ nf roundtrip f ]+ [ bench "lzlib (lzlib)" $ nf roundtrip f+ , bench "lzlib (gmp)" $ nf roundtrip g+ ] , bgroup "unpack" [ bench "lzlib" $ nfIO unpack ] , env decompressed $ \f ->@@ -36,5 +37,7 @@ , bgroup "unpack" [ bench "lzlib" $ nfIO unpack' ] ]- where file = BS.readFile "lzlib-1.10.tar.lz"- decompressed = BS.readFile "lzlib-1.10.tar"+ where file = BSL.readFile "lzlib-1.10.tar.lz"+ bigFile = BSL.readFile "gmp-6.1.2.tar.lz"+ files = (,) <$> file <*> bigFile+ decompressed = BSL.readFile "lzlib-1.10.tar"
lzlib.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: lzlib-version: 0.2.0.2+version: 0.3.0.0 license: BSD3 license-file: LICENSE copyright: Copyright: (c) 2019 Vanessa McHale
src/Codec/Lzip.hs view
@@ -13,10 +13,10 @@ import Data.Bits (shiftL) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL+import Data.Functor (($>)) import Data.Int (Int64)-import Data.Maybe (fromMaybe) import Foreign.Marshal.Alloc (free, mallocBytes)-import Foreign.Ptr (Ptr, castPtr, plusPtr)+import Foreign.Ptr (Ptr, castPtr) import System.IO.Unsafe (unsafeDupablePerformIO) data CompressionLevel = Zero@@ -48,16 +48,21 @@ -- | This does not do any error recovery; for that you should use -- [lziprecover](https://www.nongnu.org/lzip/lziprecover.html).+--+-- Doesn't work on empty 'BSL.ByteString's {-# NOINLINE decompress #-}-decompress :: BS.ByteString -> BSL.ByteString-decompress bs = unsafeDupablePerformIO $ BS.useAsCStringLen bs $ \(bytes, sz) -> do+decompress :: BSL.ByteString -> BSL.ByteString+decompress bs = unsafeDupablePerformIO $ do decoder <- lZDecompressOpen maxSz <- lZDecompressWriteSize decoder - let bufMax = min (fromIntegral maxSz) sz+ let bss = BSL.toChunks bs+ sz = maximum (BS.length <$> bss)+ bufMax = fromIntegral maxSz+ buf <- mallocBytes sz- res <- loop decoder (buf, bufMax) (castPtr bytes, sz) 0 sz mempty+ res <- loop decoder bss bufMax (buf, sz) mempty void $ lZDecompressClose decoder free buf@@ -65,51 +70,76 @@ pure (BSL.fromChunks res) where- loop :: LZDecoderPtr -> (Ptr UInt8, Int) -> (Ptr UInt8, Int) -> Int -> Int -> [BS.ByteString] -> IO [BS.ByteString]- loop decoder (buf, bufSz) (bytes, sz) offset total !acc = do- let toWrite = min bufSz (total - offset)- bytesWritten <- if offset < total- then Just <$> lZDecompressWrite decoder (bytes `plusPtr` offset) (fromIntegral toWrite)- else Nothing <$ lZDecompressFinish decoder+ loop :: LZDecoderPtr -> [BS.ByteString] -> Int -> (Ptr UInt8, Int) -> [BS.ByteString] -> IO [BS.ByteString]+ loop decoder bss maxSz (buf, bufSz) !acc = do+ bss' <- case bss of+ [bs'] -> if BS.length bs' > maxSz + then do+ let (bs'', rest) = BS.splitAt maxSz bs'+ BS.useAsCStringLen bs'' $ \(bytes, sz) ->+ lZDecompressWrite decoder (castPtr bytes) (fromIntegral sz) $> [rest]+ else+ BS.useAsCStringLen bs' $ \(bytes, sz) -> do+ void $ lZDecompressWrite decoder (castPtr bytes) (fromIntegral sz)+ void $ lZDecompressFinish decoder+ pure []+ (bs':bss') -> if BS.length bs' > maxSz+ then do+ let (bs'', rest) = BS.splitAt maxSz bs'+ BS.useAsCStringLen bs'' $ \(bytes, sz) ->+ lZDecompressWrite decoder (castPtr bytes) (fromIntegral sz) $> rest:bss'+ else+ BS.useAsCStringLen bs' $ \(bytes, sz) ->+ lZDecompressWrite decoder (castPtr bytes) (fromIntegral sz) $>+ bss'+ [] -> pure []+ res <- lZDecompressFinished decoder if res == 1 then pure acc else do- let newOffset = offset + fromIntegral (fromMaybe 0 bytesWritten) bytesRead <- lZDecompressRead decoder buf (fromIntegral bufSz) bsActual <- BS.packCStringLen (castPtr buf, fromIntegral bytesRead)- loop decoder (buf, bufSz) (bytes, sz) newOffset total (acc ++ [bsActual])+ loop decoder bss' maxSz (buf, bufSz) (acc ++ [bsActual]) +-- | Defaults to 'Nine' {-# NOINLINE compress #-}-compress :: BS.ByteString -> BSL.ByteString+compress :: BSL.ByteString -> BSL.ByteString compress = compressWith Nine {-# NOINLINE compressWith #-}-compressWith :: CompressionLevel -> BS.ByteString -> BSL.ByteString-compressWith level bs = unsafeDupablePerformIO $ BS.useAsCStringLen bs $ \(bytes, sz) -> do+compressWith :: CompressionLevel -> BSL.ByteString -> BSL.ByteString+compressWith level bstr = unsafeDupablePerformIO $ do - encoder <- lZCompressOpen (fromIntegral $ dictionarySize sz) (fromIntegral matchLenLimit) (fromIntegral memberSize)+ let bss = BSL.toChunks bstr+ sz = fromIntegral (BSL.length bstr) - void $ lZCompressWrite encoder (castPtr bytes) (fromIntegral sz)- void $ lZCompressFinish encoder+ encoder <- lZCompressOpen (fromIntegral $ dictionarySize sz) (fromIntegral matchLenLimit) (fromIntegral memberSize) let delta = sz `div` 4 + 64 newBytes <- mallocBytes delta- res <- readLoop encoder (newBytes, delta) 0 mempty+ res <- loop encoder bss (newBytes, delta) 0 mempty void $ lZCompressClose encoder pure (BSL.fromChunks res) where- readLoop :: LZEncoderPtr -> (Ptr UInt8, Int) -> Int -> [BS.ByteString] -> IO [BS.ByteString]- readLoop encoder (buf, sz) bytesRead acc = do+ loop :: LZEncoderPtr -> [BS.ByteString] -> (Ptr UInt8, Int) -> Int -> [BS.ByteString] -> IO [BS.ByteString]+ loop encoder bss (buf, sz) bytesRead acc = do+ bss' <- case bss of+ [bs] -> BS.useAsCStringLen bs $ \(bytes, sz') -> do+ void $ lZCompressWrite encoder (castPtr bytes) (fromIntegral sz')+ lZCompressFinish encoder $> []+ (bs:bss') -> BS.useAsCStringLen bs $ \(bytes, sz') ->+ lZCompressWrite encoder (castPtr bytes) (fromIntegral sz') $> bss'+ [] -> pure [] bytesActual <- lZCompressRead encoder buf (fromIntegral sz) res <- lZCompressFinished encoder bsActual <- BS.packCStringLen (castPtr buf, fromIntegral bytesActual) if res == 1 then pure (acc ++ [bsActual])- else readLoop encoder (buf, sz) (bytesRead + fromIntegral bytesActual) (acc ++ [bsActual])+ else loop encoder bss' (buf, sz) (bytesRead + fromIntegral bytesActual) (acc ++ [bsActual]) memberSize :: Int64 memberSize = maxBound
stack.yaml view
@@ -1,5 +1,5 @@ ----resolver: lts-14.5+resolver: lts-14.7 ghc-options: {"$locals": -ddump-to-file -ddump-hi} packages: - '.'
test/Spec.hs view
@@ -2,7 +2,6 @@ import Codec.Lzip import Control.Monad (filterM)-import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.Foldable (traverse_) import System.Directory (doesFileExist)@@ -11,14 +10,14 @@ compressFile :: FilePath -> Spec compressFile fp = parallel $ it "roundtrip should be identity" $ do- str <- BS.readFile fp- decompress (BSL.toStrict (compress str)) `shouldBe` (BSL.fromStrict str)+ str <- BSL.readFile fp+ decompress (compress str) `shouldBe` str roundtripFile :: FilePath -> Spec roundtripFile fp = parallel $ it "roundtrip should be identity" $ do- str <- BS.readFile fp- compress (BSL.toStrict (decompress str)) `shouldBe` (BSL.fromStrict str)+ str <- BSL.readFile fp+ compress (decompress str) `shouldBe` str main :: IO () main = do