zip-conduit 0.2.2.2 → 0.3.0
raw patch · 6 files changed
+78/−259 lines, 6 filesdep −LibZipdep −criteriondep −randomdep ~HUnitdep ~basedep ~bytestring
Dependencies removed: LibZip, criterion, random, zip-archive
Dependency ranges changed: HUnit, base, bytestring, conduit, conduit-extra, digest, directory, resourcet, temporary, time, transformers
Files
- bench/Bench.hs +0/−130
- src/Codec/Archive/Zip.hs +43/−71
- src/Codec/Archive/Zip/Internal.hs +0/−1
- src/Codec/Archive/Zip/Util.hs +3/−4
- tests/Tests.hs +6/−6
- zip-conduit.cabal +26/−47
− bench/Bench.hs
@@ -1,130 +0,0 @@-{-# LANGUAGE PackageImports #-}--module Main where--import Control.Monad (forM_)-import qualified Data.ByteString.Lazy as B (hPut, pack, readFile)-import Data.Word (Word8)-import System.FilePath ((</>), (<.>))-import System.IO (IOMode(..), hPutStr, withFile)-import System.Directory (getCurrentDirectory, setCurrentDirectory)--import Criterion.Main (Benchmark, bench, bgroup, defaultMain, nfIO)-import System.IO.Temp (withSystemTempDirectory, withTempDirectory)-import System.Random (getStdGen, randoms)--import qualified Codec.Archive.LibZip as L-import qualified "zip-archive" Codec.Archive.Zip as A-import "zip-conduit" Codec.Archive.Zip---import Codec.Archive.Zip---main :: IO ()-main = do- let sizes = [1024*1024, 10*1024*1024] -- ^ sizes of files for benchmarking-- withSystemTempDirectory "zip-conduit" $ \dir -> do- prepareFiles dir sizes- defaultMain (prepareBench dir $ map show sizes)----- | Prepares benchmarks.-prepareBench :: FilePath -- ^ the path to the directory with files- -> [FilePath] -- ^ file names- -> [Benchmark]-prepareBench dir names =- [ bgroup "archive"- [ bgroup "zip-conduit" $ b zipConduit- , bgroup "zip-archive" $ b zipArchive- , bgroup "libZip" $ b libZip- ]- , bgroup "unarchive"- [ bgroup "zip-conduit" $ b unZipConduit- , bgroup "zip-archive" $ b unZipArchive- -- , bgroup "libZip" $ b unLibZip- ]- ]- where- b f = map (\name -> bench name $ nfIO $ f dir name) names----- | Creates source files for archiving and archives with those--- files. File name is the size of this file in bytes.-prepareFiles :: FilePath -- ^ the path to the directory for files- -> [Int] -- ^ sizes of files to create- -> IO ()-prepareFiles dir sizes = forM_ sizes $ \s -> do- let path = dir </> show s-- createFile path s- withArchive (path <.> "zip") $ addFiles [path]----- | Creates a file of specified length with random content.-createFile :: FilePath -> Int -> IO ()-createFile path size =- withFile path WriteMode $ \h -> do- g <- getStdGen- B.hPut h $ B.pack $ take size (randoms g :: [Word8])------------------------------------------------------------------------------------ Create zip archive with three different packages.--zipConduit :: FilePath -> FilePath -> IO ()-zipConduit dir name =- withTempDirectory dir "zip-conduit" $ \tmpDir ->- withArchive (tmpDir </> name <.> "zip") $ addFiles [dir </> name]---zipArchive :: FilePath -> FilePath -> IO ()-zipArchive dir name =- withTempDirectory dir "zip-archive" $ \tmpDir -> do- ar' <- A.addFilesToArchive [] A.emptyArchive [dir </> name]- withFile (tmpDir </> name <.> "zip") WriteMode $ \h ->- B.hPut h $ A.fromArchive ar'---libZip :: FilePath -> FilePath -> IO ()-libZip dir name =- withTempDirectory dir "libZip" $ \tmpDir ->- L.withArchive [L.CreateFlag] (tmpDir </> name <.> "zip") $ do- zs <- L.sourceFile (dir </> name) 0 0- L.addFile (dir </> name) zs- return ()------------------------------------------------------------------------------------ Exctract files from archive with three different packages.--unZipConduit :: FilePath -> FilePath -> IO ()-unZipConduit dir name = do- withArchive (dir </> name <.> "zip") $ do- names <- entryNames- extractFiles names $ dir -- </> "zip-conduit"---unZipArchive :: FilePath -> FilePath -> IO ()-unZipArchive dir name = do- bytes <- B.readFile (dir </> name <.> "zip")- withCurrentDirectory dir . A.extractFilesFromArchive [] $ A.toArchive bytes---unLibZip :: FilePath -> FilePath -> IO ()-unLibZip dir name = do- bytes <- L.withArchive [] (dir </> name <.> "zip") $ L.fileContentsIx [] 0- withFile (dir </> name) WriteMode $ \h ->- hPutStr h bytes------------------------------------------------------------------------------------ Utils.---- | Runs action in the specified current directory.-withCurrentDirectory :: FilePath -> IO a -> IO a-withCurrentDirectory path action = withSystemTempDirectory path $ \dir -> do- current <- getCurrentDirectory- setCurrentDirectory dir- res <- action- setCurrentDirectory current- return res
src/Codec/Archive/Zip.hs view
@@ -5,28 +5,29 @@ @ \{\-\# LANGUAGE OverloadedStrings \#\-\} -import qualified Data.Conduit.Binary as CB-import Codec.Archive.Zip-+import Data.Conduit.Combinators+import Codec.Archive.Zip +main :: IO () main = do withArchive \"some.zip\" $ do- sinkEntry \"first\" $ CB.sourceLbs \"hello\"- sinkEntry \"second\" $ CB.sourceLbs \"world\"+ sinkEntry \"first\" $ sourceLazy \"hello\"+ sinkEntry \"second\" $ sourceLazy \"world\" @ Source first entry from the archive: @-import System.Environment (getArgs)-import qualified Data.Conduit.Binary as CB-import Codec.Archive.Zip+import System.Environment (getArgs)+import Data.Conduit.Combinators+import Codec.Archive.Zip +main :: IO () main = do archivePath:_ <- getArgs withArchive archivePath $ do name:_ <- entryNames- sourceEntry name $ CB.sinkFile name+ sourceEntry name $ sinkFile name @ List entries in the archive:@@ -35,41 +36,12 @@ import System.Environment (getArgs) import Codec.Archive.Zip +main :: IO () main = do archivePath:_ <- getArgs names <- withArchive archivePath entryNames mapM_ putStrLn names @---Add files to the archive:--@-import Control.Monad (filterM)-import System.Directory (doesFileExist, getDirectoryContents)-import System.Environment (getArgs)-import Codec.Archive.Zip--main = do- dirPath:_ <- getArgs- paths <- getDirectoryContents dirPath- filePaths <- filterM doesFileExist paths- withArchive \"some.zip\" $ addFiles filePaths-@--Extract files from the archive:--@-import System.Environment (getArgs)-import Codec.Archive.Zip--main = do- dirPath:_ <- getArgs- withArchive \"some.zip\" $ do- names <- entryNames- extractFiles names dirPath-@- -} module Codec.Archive.Zip@@ -99,7 +71,6 @@ ) where import Prelude hiding (readFile, zip)-import Control.Applicative ((<$>)) import Control.Monad (foldM, forM_) import Data.ByteString (ByteString) import qualified Data.ByteString as B (empty)@@ -111,11 +82,13 @@ import System.FilePath ((</>), dropDrive, takeDirectory) import System.IO (Handle, IOMode(..), SeekMode(..), hClose, hSeek, hTell, openFile, withFile) -import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.State (StateT, evalStateT, get, gets, modify, put)-import Control.Monad.Trans.Resource (ResourceT, MonadResource, runResourceT)-import Data.Conduit (Sink, Source, ($$), ($=), (=$))-import qualified Data.Conduit.Binary as CB (isolate, sinkFile, sinkHandle, sourceFile, sourceIOHandle)+import Control.Monad.Trans.Resource (ResourceT, MonadResource)+import Conduit (PrimMonad, MonadThrow)+import Data.Conduit (Void, ConduitT, runConduitRes, (.|))+import qualified Data.Conduit.Binary as CB (isolate)+import qualified Data.Conduit.Combinators as CC (sinkFile, sinkHandle, sourceFile, sourceIOHandle) import qualified Data.Conduit.List as CL (map) import qualified Data.Conduit.Internal as CI (zipSinks) import Data.Conduit.Zlib (WindowBits(..), compress, decompress)@@ -137,8 +110,8 @@ } deriving (Show) -withArchive :: FilePath -> Archive a -> IO a-withArchive path ar = do+withArchive :: MonadIO m => FilePath -> Archive a -> m a+withArchive path ar = liftIO $ do zip <- ifM (doesFileExist path) (readZip path) (return $ emptyZip path)@@ -184,36 +157,35 @@ ------------------------------------------------------------------------------ -- Conduit interface -- | Stream the contents of an archive entry to the specified sink.-sourceEntry :: FilePath -> Sink ByteString (ResourceT Archive) a -> Archive a+sourceEntry :: FilePath -> ConduitT ByteString Void (ResourceT IO) a -> Archive a sourceEntry e sink = do zip <- get- runResourceT $ sourceFile zip e $$ sink+ liftIO . runConduitRes $ sourceFile zip e .| sink -- | Stream data from the specified source to an archive entry.-sinkEntry :: FilePath -> Source (ResourceT Archive) ByteString -> Archive ()+sinkEntry :: FilePath -> ConduitT () ByteString (ResourceT IO) () -> Archive () sinkEntry e source = do zip <- get time <- liftIO getCurrentTime- zip' <- runResourceT $ source $$ sinkFile zip e Deflate time+ zip' <- liftIO . runConduitRes $ source .| sinkFile zip e Deflate time put zip' -- | Stream data from the specified source to an uncompressed archive entry.-sinkEntryUncompressed :: FilePath -> Source (ResourceT Archive) ByteString -> Archive ()+sinkEntryUncompressed :: FilePath -> ConduitT () ByteString (ResourceT IO) () -> Archive () sinkEntryUncompressed f source = do zip <- get time <- liftIO getCurrentTime- zip' <- runResourceT $ source $$ sinkFile zip f NoCompression time+ zip' <- liftIO . runConduitRes $ source .| sinkFile zip f NoCompression time put zip' --sourceFile :: MonadResource m => Zip -> FilePath -> Source m ByteString+sourceFile :: (PrimMonad m, MonadThrow m, MonadResource m) => Zip -> FilePath -> ConduitT () ByteString m () sourceFile zip f =- source $= CB.isolate (fromIntegral $ fhCompressedSize fileHeader)- $= decomp+ source .| CB.isolate (fromIntegral $ fhCompressedSize fileHeader)+ .| decomp where- source = CB.sourceIOHandle $ do+ source = CC.sourceIOHandle $ do h <- openFile (zipFilePath zip) ReadMode offset <- calculateFileDataOffset h fileHeader hSeek h AbsoluteSeek offset@@ -229,8 +201,8 @@ Deflate -> decompress $ WindowBits (-15) -sinkFile :: MonadResource m => Zip -> FilePath -> CompressionMethod -> UTCTime- -> Sink ByteString m Zip+sinkFile :: (PrimMonad m, MonadThrow m, MonadResource m)+ => Zip -> FilePath -> CompressionMethod -> UTCTime -> ConduitT ByteString Void m Zip sinkFile zip f compression time = do h <- liftIO $ openFile (zipFilePath zip) ReadWriteMode -- not WriteMode because if the file already exists, then it would be truncated to zero length fh <- liftIO $ appendLocalFileHeader h zip f compression time@@ -271,7 +243,7 @@ zip <- get liftIO $ forM_ fs $ \fileName -> do createDirectoryIfMissing True $ dir </> takeDirectory fileName- runResourceT $ sourceFile zip fileName $$ CB.sinkFile (dir </> fileName)+ runConduitRes $ sourceFile zip fileName .| CC.sinkFile (dir </> fileName) ------------------------------------------------------------------------------@@ -286,7 +258,7 @@ m <- clockTimeToUTCTime <$> getModificationTime f #endif fh <- appendLocalFileHeader h zip (funPath $ dropDrive f) Deflate m- dd <- runResourceT $ CB.sourceFile f $$ sinkData h Deflate+ dd <- runConduitRes $ CC.sourceFile f .| sinkData h Deflate writeDataDescriptorFields h dd offset return $ updateZip zip fh dd where@@ -321,8 +293,8 @@ } -sinkData :: MonadResource m- => Handle -> CompressionMethod -> Sink ByteString m DataDescriptor+sinkData :: (PrimMonad m, MonadThrow m, MonadResource m)+ => Handle -> CompressionMethod -> ConduitT ByteString Void m DataDescriptor sinkData h compression = do ((uncompressedSize, crc32), compressedSize) <- case compression of@@ -334,14 +306,14 @@ , ddUncompressedSize = fromIntegral uncompressedSize } where- compressSink :: MonadResource m => Sink ByteString m Int- compressSink = compress 6 (WindowBits (-15)) =$ sizeDataSink+ compressSink :: (PrimMonad m, MonadThrow m, MonadResource m) => ConduitT ByteString Void m Int+ compressSink = compress 6 (WindowBits (-15)) .| sizeDataSink - sizeCrc32Sink :: MonadResource m => Sink ByteString m (Int, Word32)+ sizeCrc32Sink :: MonadResource m => ConduitT ByteString Void m (Int, Word32) sizeCrc32Sink = CI.zipSinks sizeSink crc32Sink - sizeDataSink :: MonadResource m => Sink ByteString m Int- sizeDataSink = fst <$> CI.zipSinks sizeSink (CB.sinkHandle h)+ sizeDataSink :: MonadResource m => ConduitT ByteString Void m Int+ sizeDataSink = fst <$> CI.zipSinks sizeSink (CC.sinkHandle h) -- Writes data descriptor fields (crc-32, compressed size and@@ -381,12 +353,12 @@ fileNames = entryNames -getSource :: MonadResource m => FilePath -> Archive (Source m ByteString)+getSource :: (MonadThrow m, PrimMonad m, MonadResource m) => FilePath -> Archive (ConduitT () ByteString m ()) getSource f = gets $ \zip -> sourceFile zip f -getSink :: MonadResource m- => FilePath -> UTCTime -> Archive (Sink ByteString m ())+getSink :: (MonadThrow m, PrimMonad m, MonadResource m)+ => FilePath -> UTCTime -> Archive (ConduitT ByteString Void m ()) getSink f time = gets $ \zip -> do sinkFile zip f Deflate time return ()
src/Codec/Archive/Zip/Internal.hs view
@@ -1,7 +1,6 @@ module Codec.Archive.Zip.Internal where import Prelude hiding (readFile)-import Control.Applicative ((<$>)) import Control.Monad (unless) import Data.ByteString (ByteString) import qualified Data.ByteString as B (hGet, hPut, length, pack, empty)
src/Codec/Archive/Zip/Util.hs view
@@ -1,6 +1,5 @@ module Codec.Archive.Zip.Util where -import Control.Applicative ((<$>)) import Data.Bits ((.&.), shiftR, shiftL) import Data.ByteString (ByteString) import qualified Data.ByteString as B (length)@@ -9,7 +8,7 @@ import Data.Word (Word16, Word32) import System.Time (ClockTime(..)) -import Data.Conduit (Sink)+import Data.Conduit (Void, ConduitT) import qualified Data.Conduit.List as CL (fold) import Data.Digest.CRC32 (crc32Update) import Data.Serialize.Get (Get, getWord32le, isEmpty, lookAhead, runGet, skip)@@ -107,11 +106,11 @@ ------------------------------------------------------------------------------ -- Conduit utils.-crc32Sink :: Monad m => Sink ByteString m Word32+crc32Sink :: Monad m => ConduitT ByteString Void m Word32 crc32Sink = CL.fold crc32Update 0 -sizeSink :: Monad m => Sink ByteString m Int+sizeSink :: Monad m => ConduitT ByteString Void m Int sizeSink = CL.fold (\acc input -> B.length input + acc) 0
tests/Tests.hs view
@@ -4,6 +4,7 @@ module Main where import Control.Monad (forM, forM_)+import Control.Monad.IO.Class (liftIO) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B (append, hGetContents, hPut) import Data.List ((\\))@@ -13,8 +14,7 @@ import System.FilePath ((</>), dropDrive, takeFileName) import System.IO (IOMode(..), withFile) -import Control.Monad.Trans.Resource (runResourceT)-import Data.Conduit (Source, ($$))+import Data.Conduit (runConduitRes, ConduitT, (.|)) import qualified Data.Conduit.List as CL (fold, sourceList) import System.IO.Temp (withSystemTempDirectory) import Test.Framework (Test, defaultMain, testGroup)@@ -41,7 +41,7 @@ assertConduit :: Monad m- => (FilePath -> Source m ByteString -> Archive b) -> IO ()+ => (FilePath -> ConduitT () ByteString m () -> Archive b) -> IO () assertConduit s = withSystemTempDirectory "zip-conduit" $ \dir -> do let archivePath = dir </> archiveName@@ -103,7 +103,7 @@ archive :: Monad m- => (FilePath -> Source m ByteString -> Archive b)+ => (FilePath -> ConduitT () ByteString m () -> Archive b) -> FilePath -> [(FilePath, ByteString)] -> IO () archive s archivePath entriesInfo = withArchive archivePath $@@ -143,7 +143,7 @@ time <- getCurrentTime withArchive archivePath $ do sink <- getSink fileName time- runResourceT $ CL.sourceList [content] $$ sink+ liftIO . runConduitRes $ CL.sourceList [content] .| sink -- | Gets content from 'fileName' in archive at 'arcihvePath'.@@ -151,4 +151,4 @@ unarchiveD archivePath fileName = withArchive archivePath $ do source <- getSource fileName- runResourceT $ source $$ CL.fold B.append ""+ liftIO . runConduitRes $ source .| CL.fold B.append ""
zip-conduit.cabal view
@@ -1,14 +1,14 @@ Name: zip-conduit-Version: 0.2.2.2-Synopsis: Working with zip archives via conduits.+Version: 0.3.0+Synopsis: Working with zip archives via conduits Description: Working with zip archives via conduits. License: BSD3 License-file: LICENSE Author: Tim Cherganov Maintainer: cherganov@gmail.com Category: Codec, Conduit-Homepage: https://github.com/tymmym/zip-conduit-Bug-reports: https://github.com/tymmym/zip-conduit/issues+Homepage: https://github.com/timcherganov/zip-conduit+Bug-reports: https://github.com/timcherganov/zip-conduit/issues Build-type: Simple Cabal-version: >=1.10 @@ -17,20 +17,20 @@ Hs-source-dirs: src Build-depends:- base >= 4.3 && < 5- , bytestring >= 0.9 && < 0.11- , cereal >= 0.3 && < 0.5- , conduit >= 1.1 && < 1.3- , digest == 0.0.*- , directory >= 1.1 && < 1.3- , filepath == 1.3.*+ base >= 4.8 && < 5+ , bytestring >= 0.9 && < 0.12+ , cereal >= 0.3 && < 0.6+ , conduit >= 1.3 && < 1.4+ , conduit-extra >= 1.3 && < 1.4+ , digest < 0.1+ , directory >= 1.1 && < 1.4+ , filepath >= 1.3 && < 1.5 , mtl >= 2.0 && < 2.3 , old-time >= 1.0 && < 1.2- , time >= 1.4 && < 1.6- , transformers >= 0.3 && < 0.5- , utf8-string == 0.3.*- , conduit-extra == 1.1.*- , resourcet == 1.1.*+ , resourcet >= 1.2 && < 1.3+ , time >= 1.4 && < 1.10+ , transformers >= 0.3 && < 0.6+ , utf8-string >= 0.3 && < 1.1 Exposed-modules: Codec.Archive.Zip@@ -49,40 +49,19 @@ Main-is: Tests.hs Build-depends:- base >= 4.3 && < 5- , bytestring >= 0.9 && < 0.11- , conduit >= 1.1 && < 1.3- , resourcet == 1.1.*- , directory >= 1.1 && < 1.3- , filepath == 1.3.*- , HUnit == 1.2.*+ base >= 4.8 && < 5+ , bytestring >= 0.10.2 && < 0.12+ , conduit >= 1.3 && < 1.4+ , resourcet >= 1.2 && < 1.3+ , directory >= 1.1 && < 1.4+ , filepath >= 1.3 && < 1.5+ , HUnit >= 1.2 && < 1.7 , hpc >= 0.5 && < 0.7 , mtl >= 2.0 && < 2.3- , temporary >= 1.1 && < 1.3+ , temporary >= 1.1 && < 1.4 , test-framework >= 0.6 && < 0.9 , test-framework-hunit >= 0.2 && < 0.4- , time >= 1.4 && < 1.6- , zip-conduit-- Ghc-options: -Wall -fno-warn-unused-do-bind- Default-language: Haskell2010---Benchmark bench- Type: exitcode-stdio-1.0- Hs-source-dirs: bench- Main-is: Bench.hs-- Build-depends:- base >= 4.3 && < 5- , bytestring >= 0.9 && < 0.11- , directory >= 1.1 && < 1.3- , criterion == 1.0.*- , filepath == 1.3.*- , LibZip >= 0.10 && < 0.12- , random >= 1.0 && < 1.2- , temporary >= 1.1 && < 1.3- , zip-archive >= 0.1 && < 0.3+ , time >= 1.4 && < 1.10 , zip-conduit Ghc-options: -Wall -fno-warn-unused-do-bind@@ -91,4 +70,4 @@ Source-repository head type: git- location: git://github.com/tymmym/zip-conduit.git+ location: https://github.com/timcherganov/zip-conduit.git