lzlib 0.1.1.1 → 0.2.0.0

raw patch · 7 files changed

+126/−57 lines, 7 filesdep +criteriondep +temporarydep −filepatterndep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, temporary

Dependencies removed: filepattern

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• bench/Bench.hs +40/−0
• lzlib.cabal +28/−14
• src/Codec/Lzip.hs +28/−26
• src/Codec/Lzip/Raw.chs +6/−6
• stack.yaml +1/−0
• test/Spec.hs +17/−11

@@ -1,5 +1,11 @@ # lzlib +## 0.2.0.0++  * Performance improvements+  * Pure functions no longer occur in IO+  * Change type signatures of compression/decompression functions+ ## 0.1.1.1      * Fix distribution

@@ -0,0 +1,40 @@+module Main (main) where++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' :: BS.ByteString -> BSL.ByteString+roundtrip' = decompress . BSL.toStrict . compress++unpack :: IO ()+unpack = withSystemTempDirectory "lzlib" $+    \fp -> BSL.writeFile (fp </> "lzlib.tar.lz") =<<+        (roundtrip <$> BS.readFile "lzlib-1.10.tar.lz")++unpack' :: IO ()+unpack' = withSystemTempDirectory "lzlib" $+    \fp -> BSL.writeFile (fp </> "lzlib.tar") =<<+        (roundtrip' <$> BS.readFile "lzlib-1.10.tar")++main :: IO ()+main =+    defaultMain [ env file $ \ f ->+                  bgroup "roundtrip"+                      [ bench "lzlib" $ nf roundtrip f ]+                , bgroup "unpack"+                      [ bench "lzlib" $ nfIO unpack ]+                , env decompressed $ \f ->+                  bgroup "roundtrip'"+                      [ bench "lzlib" $ nf roundtrip' f ]+                , bgroup "unpack"+                      [ bench "lzlib" $ nfIO unpack' ]+                ]+    where file = BS.readFile "lzlib-1.10.tar.lz"+          decompressed = BS.readFile "lzlib-1.10.tar"

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               lzlib-version:            0.1.1.1+version:            0.2.0.0 license:            BSD3 license-file:       LICENSE copyright:          Copyright: (c) 2019 Vanessa McHale@@ -51,7 +51,10 @@     other-extensions: BangPatterns     include-dirs:     cbits     install-includes: cbits/lzlib.h-    ghc-options:      -Wall+    ghc-options:+        -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Wredundant-constraints+     build-depends:         base >=4.9 && <5,         bytestring -any@@ -59,11 +62,6 @@     if !flag(cross)         build-tool-depends: c2hs:c2hs -any -    if impl(ghc >=8.0)-        ghc-options:-            -Wincomplete-uni-patterns -Wincomplete-record-updates-            -Wredundant-constraints-     if impl(ghc >=8.4)         ghc-options: -Wmissing-export-lists @@ -72,20 +70,36 @@     main-is:          Spec.hs     hs-source-dirs:   test     default-language: Haskell2010-    ghc-options:      -threaded -rtsopts -with-rtsopts=-N -Wall+    ghc-options:+        -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns+        -Wincomplete-record-updates -Wredundant-constraints+     build-depends:         base -any,         lzlib -any,         hspec -any,         bytestring -any,-        filepattern -any,-        filepath -any,         directory -any -    if impl(ghc >=8.0)-        ghc-options:-            -Wincomplete-uni-patterns -Wincomplete-record-updates-            -Wredundant-constraints+    if impl(ghc >=8.4)+        ghc-options: -Wmissing-export-lists++benchmark lzlib-bench+    type:             exitcode-stdio-1.0+    main-is:          Bench.hs+    hs-source-dirs:   bench+    default-language: Haskell2010+    ghc-options:+        -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+        -Wredundant-constraints++    build-depends:+        base -any,+        lzlib -any,+        criterion -any,+        bytestring -any,+        temporary -any,+        filepath -any      if impl(ghc >=8.4)         ghc-options: -Wmissing-export-lists

@@ -1,8 +1,8 @@ {-# LANGUAGE BangPatterns #-} -module Codec.Lzip ( compressStrict-                  , compressWithStrict-                  , decompressStrict+module Codec.Lzip ( compress+                  , compressWith+                  , decompress                   , CompressionLevel (..)                   -- * Low-level bindings                   , module Codec.Lzip.Raw@@ -12,6 +12,7 @@ import           Control.Monad         (void) import           Data.Bits             (shiftL) import qualified Data.ByteString       as BS+import qualified Data.ByteString.Lazy  as BSL import           Data.Int              (Int64) import           Data.Maybe            (fromMaybe) import           Data.Semigroup@@ -48,9 +49,9 @@  -- | This does not do any error recovery; for that you should use -- [lziprecover](https://www.nongnu.org/lzip/lziprecover.html).-{-# NOINLINE decompressStrict #-}-decompressStrict :: BS.ByteString -> BS.ByteString-decompressStrict bs = unsafePerformIO $ BS.useAsCStringLen bs $ \(bytes, sz) -> do+{-# NOINLINE decompress #-}+decompress :: BS.ByteString -> BSL.ByteString+decompress bs = unsafePerformIO $ BS.useAsCStringLen bs $ \(bytes, sz) -> do      decoder <- lZDecompressOpen     maxSz <- lZDecompressWriteSize decoder@@ -62,10 +63,10 @@     void $ lZDecompressClose decoder     free buf -    pure res+    pure (BSL.fromChunks res)      where-        loop :: LZDecoderPtr -> (Ptr UInt8, Int) -> (Ptr UInt8, Int) -> Int -> Int -> BS.ByteString -> IO BS.ByteString+        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@@ -78,42 +79,43 @@                     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 (buf, bufSz) (bytes, sz) newOffset total (acc ++ [bsActual]) -{-# NOINLINE compressStrict #-}-compressStrict :: BS.ByteString -> BS.ByteString-compressStrict = compressWithStrict Nine+{-# NOINLINE compress #-}+compress :: BS.ByteString -> BSL.ByteString+compress = compressWith Nine --- TODO: memory use-{-# NOINLINE compressWithStrict #-}-compressWithStrict :: CompressionLevel -> BS.ByteString -> BS.ByteString-compressWithStrict level bs = unsafePerformIO $ BS.useAsCStringLen bs $ \(bytes, sz) -> do+{-# NOINLINE compressWith #-}+compressWith :: CompressionLevel -> BS.ByteString -> BSL.ByteString+compressWith level bs = unsafePerformIO $ BS.useAsCStringLen bs $ \(bytes, sz) -> do -    encoder <- lZCompressOpen (fromIntegral dictionarySize) (fromIntegral matchLenLimit) (fromIntegral memberSize)+    encoder <- lZCompressOpen (fromIntegral $ dictionarySize sz) (fromIntegral matchLenLimit) (fromIntegral memberSize)      void $ lZCompressWrite encoder (castPtr bytes) (fromIntegral sz)     void $ lZCompressFinish encoder -    newBytes <- mallocBytes sz-    res <- readLoop encoder (newBytes, sz) 0 mempty+    let delta = sz `div` 4 + 64+    newBytes <- mallocBytes delta+    res <- readLoop encoder (newBytes, delta) 0 mempty      void $ lZCompressClose encoder -    pure res+    pure (BSL.fromChunks res)      where--        readLoop :: LZEncoderPtr -> (Ptr UInt8, Int) -> Int -> BS.ByteString -> IO BS.ByteString+        readLoop :: LZEncoderPtr -> (Ptr UInt8, Int) -> Int -> [BS.ByteString] -> IO [BS.ByteString]         readLoop encoder (buf, sz) bytesRead acc = do             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)+                then pure (acc ++ [bsActual])+                else readLoop encoder (buf, sz) (bytesRead + fromIntegral bytesActual) (acc ++ [bsActual])          memberSize :: Int64         memberSize = maxBound -        dictionarySize = _dictionarySize $ encoderOptions level-        matchLenLimit = _matchLenLimit $ encoderOptions level+        -- saves memory+        dictionarySize = max (fromIntegral lZMinDictionarySize) . min (_dictionarySize $ encoderOptions level)+        matchLenLimit = _matchLenLimit opts+        opts = encoderOptions level

@@ -65,12 +65,12 @@  {# fun pure LZ_version as ^ {} -> `String' #} {# fun pure LZ_strerror as ^ { `LZErrno' } -> `String' #}-{# fun LZ_min_dictionary_bits as ^ {} -> `CInt' #}-{# fun LZ_min_dictionary_size as ^ {} -> `CInt' #}-{# fun LZ_max_dictionary_bits as ^ {} -> `CInt' #}-{# fun LZ_max_dictionary_size as ^ {} -> `CInt' #}-{# fun LZ_min_match_len_limit as ^ {} -> `CInt' #}-{# fun LZ_max_match_len_limit as ^ {} -> `CInt' #}+{# fun pure LZ_min_dictionary_bits as ^ {} -> `CInt' #}+{# fun pure LZ_min_dictionary_size as ^ {} -> `CInt' #}+{# fun pure LZ_max_dictionary_bits as ^ {} -> `CInt' #}+{# fun pure LZ_max_dictionary_size as ^ {} -> `CInt' #}+{# fun pure LZ_min_match_len_limit as ^ {} -> `CInt' #}+{# fun pure LZ_max_match_len_limit as ^ {} -> `CInt' #}  instance Show LZErrno where     show = lZStrerror

@@ -1,4 +1,5 @@ --- resolver: lts-14.5+ghc-options: {"$locals": -ddump-to-file -ddump-hi} packages:   - '.'

@@ -1,25 +1,31 @@ module Main ( main ) where  import           Codec.Lzip-import qualified Data.ByteString              as BS-import           Data.Foldable                (traverse_)-import           System.Directory             (doesDirectoryExist)-import           System.FilePath              ((</>))-import           System.FilePattern.Directory (getDirectoryFiles)+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) import           Test.Hspec  compressFile :: FilePath -> Spec compressFile fp = parallel $     it "roundtrip should be identity" $ do         str <- BS.readFile fp-        decompressStrict (compressStrict str) `shouldBe` str+        decompress (BSL.toStrict (compress str)) `shouldBe` (BSL.fromStrict 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)+ main :: IO () main = do-    b <- doesDirectoryExist "dist-newstyle"-    libs <- if b-        then getDirectoryFiles "dist-newstyle" ["**/*.so", "**/*.dll"]-        else pure []+    ex' <- filterM doesFileExist ["gmp-6.1.2.tar.lz", "lzlib-1.10.tar.lz"]+    ex <- filterM doesFileExist ["gmp-6.1.2.tar", "lzlib-1.10.tar"]     hspec $ do         describe "decompress/compress" $-            traverse_ compressFile (("dist-newstyle" </>) <$> libs)+            traverse_ compressFile ex+        describe "compress/decompress" $+            traverse_ roundtripFile ex'