diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -2,18 +2,16 @@ module Main where -import Control.Monad -import Control.Monad.IO.Class -import qualified Data.ByteString.Lazy as B -import Data.Word -import System.FilePath -import System.IO -import System.Directory +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.Config -import Criterion.Main -import System.IO.Temp -import System.Random +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 @@ -25,16 +23,9 @@ main = do let sizes = [1024*1024, 10*1024*1024] -- ^ sizes of files for benchmarking - withSystemTempDirectory "zip-conduit" $ \dir -> - defaultMainWith myConfig - (prepareFiles dir sizes) - (prepareBench dir $ map show sizes) - - -myConfig :: Config -myConfig = defaultConfig { - cfgPerformGC = ljust True -- ^ always GC between runs - } + withSystemTempDirectory "zip-conduit" $ \dir -> do + prepareFiles dir sizes + defaultMain (prepareBench dir $ map show sizes) -- | Prepares benchmarks. @@ -54,21 +45,19 @@ ] ] where - b f = map (\name -> bench name $ f dir name) names + 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 :: MonadIO m - => FilePath -- ^ the path to the directory for files - -> [Int] -- ^ sizes of files to create - -> m () -prepareFiles dir sizes = liftIO $ - forM_ sizes $ \s -> do - let path = dir show s +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] + createFile path s + withArchive (path <.> "zip") $ addFiles [path] -- | Creates a file of specified length with random content. diff --git a/src/Codec/Archive/Zip.hs b/src/Codec/Archive/Zip.hs --- a/src/Codec/Archive/Zip.hs +++ b/src/Codec/Archive/Zip.hs @@ -90,6 +90,7 @@ -- * High level functions , extractFiles , addFiles + , addFilesAs -- * Deprecated , fileNames @@ -98,25 +99,26 @@ ) where import Prelude hiding (readFile, zip) -import Control.Applicative -import Control.Monad +import Control.Applicative ((<$>)) +import Control.Monad (foldM, forM_) import Data.ByteString (ByteString) -import qualified Data.ByteString as B +import qualified Data.ByteString as B (empty) import Data.List (find) -import Data.Maybe -import Data.Time -import Data.Word -import System.Directory -import System.FilePath -import System.IO hiding (readFile) +import Data.Maybe (fromMaybe) +import Data.Time (UTCTime, getCurrentTime) +import Data.Word (Word32) +import System.Directory (createDirectoryIfMissing, doesFileExist, getModificationTime) +import System.FilePath ((), dropDrive, takeDirectory) +import System.IO (Handle, IOMode(..), SeekMode(..), hClose, hSeek, hTell, openFile, withFile) -import Control.Monad.IO.Class -import Control.Monad.State -import Data.Conduit -import qualified Data.Conduit.Binary as CB -import qualified Data.Conduit.List as CL -import qualified Data.Conduit.Util as CU -import Data.Conduit.Zlib +import Control.Monad.IO.Class (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 qualified Data.Conduit.List as CL (map) +import qualified Data.Conduit.Internal as CI (zipSinks) +import Data.Conduit.Zlib (WindowBits(..), compress, decompress) import Codec.Archive.Zip.Internal import Codec.Archive.Zip.Util @@ -187,6 +189,7 @@ zip <- get runResourceT $ sourceFile zip e $$ sink + -- | Stream data from the specified source to an archive entry. sinkEntry :: FilePath -> Source (ResourceT Archive) ByteString -> Archive () sinkEntry e source = do @@ -244,16 +247,25 @@ ------------------------------------------------------------------------------ -- High level functions + +-- | Appends files to the 'Zip'. The file paths are used verbatim as zip entry +-- names, save for the application of 'dropDrive'. addFiles :: [FilePath] -> Archive () -addFiles fs = do +addFiles = addFilesAs id + +-- | Appends files to the 'Zip' using a function to transform the file paths +-- into zip entry names. Useful when dealing with absolute paths. 'dropDrive' +-- is applied to the paths before the supplied function. +addFilesAs :: (FilePath -> FilePath) -> [FilePath] -> Archive () +addFilesAs funPath fs = do zip <- get zip' <- liftIO $ withFile (zipFilePath zip) ReadWriteMode $ \h -> do - zip' <- foldM (addFile h) zip fs + zip' <- foldM (addFile funPath h) zip fs writeFinish h zip' return zip' put zip' - +-- | Extracts files from the 'Zip' to a directory. extractFiles :: [FilePath] -> FilePath -> Archive () extractFiles fs dir = do zip <- get @@ -266,14 +278,14 @@ -- Low level functions -- | Appends file to the 'Zip'. -addFile :: Handle -> Zip -> FilePath -> IO Zip -addFile h zip f = do +addFile :: (FilePath -> FilePath) -> Handle -> Zip -> FilePath -> IO Zip +addFile funPath h zip f = do #if MIN_VERSION_directory(1,2,0) m <- getModificationTime f #else m <- clockTimeToUTCTime <$> getModificationTime f #endif - fh <- appendLocalFileHeader h zip (dropDrive f) Deflate m + fh <- appendLocalFileHeader h zip (funPath $ dropDrive f) Deflate m dd <- runResourceT $ CB.sourceFile f $$ sinkData h Deflate writeDataDescriptorFields h dd offset return $ updateZip zip fh dd @@ -314,8 +326,8 @@ sinkData h compression = do ((uncompressedSize, crc32), compressedSize) <- case compression of - NoCompression -> CU.zipSinks sizeCrc32Sink sizeDataSink - Deflate -> CU.zipSinks sizeCrc32Sink compressSink + NoCompression -> CI.zipSinks sizeCrc32Sink sizeDataSink + Deflate -> CI.zipSinks sizeCrc32Sink compressSink return DataDescriptor { ddCRC32 = crc32 , ddCompressedSize = fromIntegral compressedSize @@ -326,10 +338,10 @@ compressSink = compress 6 (WindowBits (-15)) =$ sizeDataSink sizeCrc32Sink :: MonadResource m => Sink ByteString m (Int, Word32) - sizeCrc32Sink = CU.zipSinks sizeSink crc32Sink + sizeCrc32Sink = CI.zipSinks sizeSink crc32Sink sizeDataSink :: MonadResource m => Sink ByteString m Int - sizeDataSink = fst <$> CU.zipSinks sizeSink (CB.sinkHandle h) + sizeDataSink = fst <$> CI.zipSinks sizeSink (CB.sinkHandle h) -- Writes data descriptor fields (crc-32, compressed size and diff --git a/src/Codec/Archive/Zip/Internal.hs b/src/Codec/Archive/Zip/Internal.hs --- a/src/Codec/Archive/Zip/Internal.hs +++ b/src/Codec/Archive/Zip/Internal.hs @@ -1,15 +1,15 @@ module Codec.Archive.Zip.Internal where import Prelude hiding (readFile) -import Control.Applicative hiding (many) +import Control.Applicative ((<$>)) +import Control.Monad (unless) import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Serialize hiding (get) -import Data.Time +import qualified Data.ByteString as B (hGet, hPut, length, pack, empty) +import Data.Serialize (Get, Put, getByteString, getWord16le, getWord32le, putByteString, putWord16le, putWord32le, runPut, skip) +import Data.Time (UTCTime) import Data.Word (Word16, Word32) -import System.IO hiding (readFile) +import System.IO (Handle, SeekMode(..), hFileSize, hSeek, hTell) -import Control.Monad.Error import Data.ByteString.UTF8 (fromString, toString) import Codec.Archive.Zip.Util diff --git a/src/Codec/Archive/Zip/Util.hs b/src/Codec/Archive/Zip/Util.hs --- a/src/Codec/Archive/Zip/Util.hs +++ b/src/Codec/Archive/Zip/Util.hs @@ -1,18 +1,18 @@ module Codec.Archive.Zip.Util where -import Control.Applicative hiding (many) -import Data.Bits +import Control.Applicative ((<$>)) +import Data.Bits ((.&.), shiftR, shiftL) import Data.ByteString (ByteString) -import qualified Data.ByteString as B -import Data.Time -import Data.Time.Clock.POSIX +import qualified Data.ByteString as B (length) +import Data.Time (UTCTime(..), TimeOfDay(..), fromGregorian, picosecondsToDiffTime, secondsToDiffTime, timeToTimeOfDay, toGregorian) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Word (Word16, Word32) -import System.Time +import System.Time (ClockTime(..)) -import Data.Conduit -import qualified Data.Conduit.List as CL -import Data.Digest.CRC32 -import Data.Serialize.Get +import Data.Conduit (Sink) +import qualified Data.Conduit.List as CL (fold) +import Data.Digest.CRC32 (crc32Update) +import Data.Serialize.Get (Get, getWord32le, isEmpty, lookAhead, runGet, skip) ifM :: Monad m => m Bool -> m a -> m a -> m a diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,26 +1,27 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PackageImports #-} module Main where -import Prelude hiding (zip) -import Control.Monad +import Control.Monad (forM, forM_) import Data.ByteString.Char8 (ByteString) -import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Char8 as B (append, hGetContents, hPut) import Data.List ((\\)) -import Data.Time -import System.Directory -import System.FilePath -import System.IO +import Data.Maybe (fromMaybe) +import Data.Time (getCurrentTime) +import System.Directory (getDirectoryContents) +import System.FilePath ((), dropDrive, takeFileName) +import System.IO (IOMode(..), withFile) -import Control.Monad.State -import Data.Conduit -import qualified Data.Conduit.List as CL -import System.IO.Temp -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.HUnit hiding (Test, path) +import Control.Monad.Trans.Resource (runResourceT) +import Data.Conduit (Source, ($$)) +import qualified Data.Conduit.List as CL (fold, sourceList) +import System.IO.Temp (withSystemTempDirectory) +import Test.Framework (Test, defaultMain, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (Assertion, assertEqual) -import Codec.Archive.Zip +import "zip-conduit" Codec.Archive.Zip main :: IO () @@ -33,7 +34,8 @@ [ testCase "conduit " (assertConduit sinkEntry) , testCase "conduit-un " (assertConduit sinkEntryUncompressed) , testCase "conduit-dep" assertConduitDeprecated - , testCase "files " assertFiles + , testCase "files " (assertFiles Nothing) + , testCase "files-as " (assertFiles $ Just ("contents" )) ] ] @@ -56,15 +58,15 @@ ] -assertFiles :: Assertion -assertFiles = +assertFiles :: Maybe (FilePath -> FilePath) -> Assertion +assertFiles mFunPath = withSystemTempDirectory "zip-conduit" $ \dir -> do -- create files filePaths <- putFiles dir filesInfo -- archive and unarchive withArchive (dir archiveName) $ do - addFiles filePaths + addFilesAdjusted filePaths names <- entryNames extractFiles names dir @@ -79,6 +81,8 @@ , ("test2.txt", "some another test text") , ("test3.txt", "one more") ] + adjustPath = fromMaybe id mFunPath + addFilesAdjusted = maybe addFiles addFilesAs mFunPath putFiles :: FilePath -> [(FilePath, ByteString)] -> IO [FilePath] putFiles dir fileInfo = @@ -90,7 +94,7 @@ getFiles :: FilePath -> IO [(FilePath, ByteString)] getFiles dir = do - let path = dir dropDrive dir + let path = dir (adjustPath $ dropDrive dir) dirContents <- getDirectoryContents path let resultFiles = map (path ) $ filter (`notElem` [".", ".."]) dirContents forM resultFiles $ \file -> do @@ -136,7 +140,7 @@ -- 'content'. archiveD :: FilePath -> FilePath -> ByteString -> IO () archiveD archivePath fileName content = do - time <- liftIO getCurrentTime + time <- getCurrentTime withArchive archivePath $ do sink <- getSink fileName time runResourceT $ CL.sourceList [content] $$ sink diff --git a/zip-conduit.cabal b/zip-conduit.cabal --- a/zip-conduit.cabal +++ b/zip-conduit.cabal @@ -1,5 +1,5 @@ Name: zip-conduit -Version: 0.2.2.1 +Version: 0.2.2.2 Synopsis: Working with zip archives via conduits. Description: Working with zip archives via conduits. License: BSD3 @@ -20,16 +20,17 @@ base >= 4.3 && < 5 , bytestring >= 0.9 && < 0.11 , cereal >= 0.3 && < 0.5 - , conduit >= 0.5.5 && < 1.1 + , conduit >= 1.1 && < 1.3 , digest == 0.0.* , directory >= 1.1 && < 1.3 , filepath == 1.3.* - , mtl == 2.1.* + , mtl >= 2.0 && < 2.3 , old-time >= 1.0 && < 1.2 - , time == 1.4.* - , transformers == 0.3.* + , time >= 1.4 && < 1.6 + , transformers >= 0.3 && < 0.5 , utf8-string == 0.3.* - , zlib-conduit >= 0.5 && < 1.1 + , conduit-extra == 1.1.* + , resourcet == 1.1.* Exposed-modules: Codec.Archive.Zip @@ -50,16 +51,17 @@ Build-depends: base >= 4.3 && < 5 , bytestring >= 0.9 && < 0.11 - , conduit >= 0.5.5 && < 1.1 + , conduit >= 1.1 && < 1.3 + , resourcet == 1.1.* , directory >= 1.1 && < 1.3 , filepath == 1.3.* , HUnit == 1.2.* , hpc >= 0.5 && < 0.7 - , mtl == 2.1.* + , mtl >= 2.0 && < 2.3 , temporary >= 1.1 && < 1.3 , test-framework >= 0.6 && < 0.9 , test-framework-hunit >= 0.2 && < 0.4 - , time == 1.4.* + , time >= 1.4 && < 1.6 , zip-conduit Ghc-options: -Wall -fno-warn-unused-do-bind @@ -75,12 +77,11 @@ base >= 4.3 && < 5 , bytestring >= 0.9 && < 0.11 , directory >= 1.1 && < 1.3 - , criterion >= 0.6 && < 0.9 + , criterion == 1.0.* , filepath == 1.3.* , LibZip >= 0.10 && < 0.12 - , random == 1.0.* + , random >= 1.0 && < 1.2 , temporary >= 1.1 && < 1.3 - , transformers == 0.3.* , zip-archive >= 0.1 && < 0.3 , zip-conduit