diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # lzlib +## 0.3.0.0 + + * Take a `BSL.ByteString` as input + * Performance improvements + ## 0.2.0.2 * Performance improvements diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,8 +1,12 @@ # lzlib +[![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/lzlib/badge)](https://matrix.hackage.haskell.org/package/lzlib) +[![Hackage](https://img.shields.io/hackage/v/lzlib.svg)](http://hackage.haskell.org/package/lzlib) +[![Dependencies of latest version on Hackage](https://img.shields.io/hackage-deps/v/lzlib.svg)](https://hackage.haskell.org/package/lzlib) + Haskell bindings to [lzlib](https://www.nongnu.org/lzip/lzlib.html). -## Building +## Hacking Run diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -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" diff --git a/lzlib.cabal b/lzlib.cabal --- a/lzlib.cabal +++ b/lzlib.cabal @@ -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 diff --git a/src/Codec/Lzip.hs b/src/Codec/Lzip.hs --- a/src/Codec/Lzip.hs +++ b/src/Codec/Lzip.hs @@ -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 diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,5 +1,5 @@ --- -resolver: lts-14.5 +resolver: lts-14.7 ghc-options: {"$locals": -ddump-to-file -ddump-hi} packages: - '.' diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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