From e131160592994a33b367db23e1e9a9d871ccfebb Mon Sep 17 00:00:00 2001 From: Mark Karpov Date: Fri, 9 Feb 2018 20:33:35 +0700 Subject: [PATCH] =?UTF-8?q?Stop=20depending=20on=20=E2=80=98path=E2=80=99,?= =?UTF-8?q?=20=E2=80=98path-io=E2=80=99,=20and=20=E2=80=98plan-b=E2=80=99?= =?UTF-8?q?=20plus=20more=20(#43)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- CHANGELOG.md | 15 ++- Codec/Archive/Zip.hs | 124 ++++++++++------- Codec/Archive/Zip/Internal.hs | 68 ++++++---- Codec/Archive/Zip/Type.hs | 113 ++++++++-------- README.md | 16 +-- stack.yaml | 6 + tests/Main.hs | 245 +++++++++++++++++++--------------- zip.cabal | 12 +- 8 files changed, 340 insertions(+), 259 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f2a0f36..f43c00c 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,8 +1,21 @@ -## Zip 0.3.0 +## Zip 1.0.0 * Works with `conduit-1.3.0`, `conduit-extra-1.3.0`, `resourcet-1.2.0` and `bzlib-conduit-0.3.0`. +* Stop depending on `path`, `path-io`, and `plub-b`. + +* Made the module `Codec.Archive.Zip.Type` non-public. + +* Remove derived instances of `Data` and `Generic` for `EntrySelector` not + to expose its inner structure. + +* Change signature of the `loadEntry` function, its second argument is now + just `EntrySelector` of the entry to add. + +* The second argument of `packDirRecur` now receives paths that are relative + to the root of the directory we pack. + ## Zip 0.2.0 * Added `MonadBase` and `MonadBaseControl` instances for the `ZipArchive` diff --git a/Codec/Archive/Zip.hs b/Codec/Archive/Zip.hs index ac9b22c..a868fc6 100644 --- a/Codec/Archive/Zip.hs +++ b/Codec/Archive/Zip.hs @@ -11,13 +11,10 @@ -- There are three things that should be clarified right away, to avoid -- confusion in the future. -- --- First, we use the 'EntrySelector' type that can be obtained from 'Path' --- 'Rel' 'File' paths. This method may seem awkward at first, but it will --- protect you from the problems with portability when your archive is --- unpacked on a different platform. Using well-typed paths is also --- something you should consider doing in your projects anyway. Even if you --- don't want to use the "Path" module in your project, it's easy to marshal --- 'FilePath' to 'Path' just before using functions from the library. +-- First, we use the 'EntrySelector' type that can be obtained from relative +-- 'FilePath's (paths to directories are not allowed). This method may seem +-- awkward at first, but it will protect you from the problems with +-- portability when your archive is unpacked on a different platform. -- -- The second thing, that is rather a consequence of the first, is that -- there is no way to add directories, or to be precise, /empty directories/ @@ -38,48 +35,41 @@ -- An example of a program that prints a list of archive entries: -- -- > import Codec.Archive.Zip --- > import Path.IO (resolveFile') -- > import System.Environment (getArgs) -- > import qualified Data.Map as M -- > -- > main :: IO () -- > main = do --- > [fp] <- getArgs --- > path <- resolveFile' fp +-- > [path] <- getArgs -- > entries <- withArchive path (M.keys <$> getEntries) -- > mapM_ print entries -- -- Create a Zip archive with a “Hello World” file: -- -- > import Codec.Archive.Zip --- > import Path (parseRelFile) --- > import Path.IO (resolveFile') -- > import System.Environment (getArgs) -- > -- > main :: IO () -- > main = do --- > [fp] <- getArgs --- > path <- resolveFile' fp --- > s <- parseRelFile "hello-world.txt" >>= mkEntrySelector +-- > [path] <- getArgs +-- > s <- mkEntrySelector "hello-world.txt" -- > createArchive path (addEntry Store "Hello, World!" s) -- -- Extract contents of a specific file and print them: -- -- > import Codec.Archive.Zip --- > import Path (parseRelFile) --- > import Path.IO (resolveFile') -- > import System.Environment (getArgs) -- > import qualified Data.ByteString.Char8 as B -- > -- > main :: IO () -- > main = do --- > [fp,f] <- getArgs --- > path <- resolveFile' fp --- > s <- parseRelFile f >>= mkEntrySelector --- > bs <- withArchive path (getEntry s) +-- > [path,f] <- getArgs +-- > s <- mkEntrySelector f +-- > bs <- withArchive path (getEntry s) -- > B.putStrLn bs {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeFamilies #-} @@ -158,15 +148,18 @@ import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Void import Data.Word (Word16) -import Path -import Path.IO +import System.Directory +import System.FilePath (()) +import System.IO.Error (isDoesNotExistError) import qualified Codec.Archive.Zip.Internal as I import qualified Data.Conduit as C import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL +import qualified Data.DList as DList import qualified Data.Map.Strict as M import qualified Data.Sequence as S import qualified Data.Set as E +import qualified System.FilePath as FP ---------------------------------------------------------------------------- -- Archive monad @@ -207,8 +200,8 @@ instance MonadBaseControl IO ZipArchive where -- @since 0.2.0 data ZipState = ZipState - { zsFilePath :: Path Abs File - -- ^ Absolute path to zip archive + { zsFilePath :: FilePath + -- ^ Path to zip archive , zsEntries :: Map EntrySelector EntryDescription -- ^ Actual collection of entries , zsArchive :: ArchiveDescription @@ -223,7 +216,7 @@ data ZipState = ZipState -- work with an existing archive. createArchive :: MonadIO m - => Path b File -- ^ Location of archive file to create + => FilePath -- ^ Location of archive file to create -> ZipArchive a -- ^ Actions that form archive's content -> m a createArchive path m = liftIO $ do @@ -263,7 +256,7 @@ createArchive path m = liftIO $ do -- with this library. withArchive :: MonadIO m - => Path b File -- ^ Location of archive to work with + => FilePath -- ^ Location of archive to work with -> ZipArchive a -- ^ Actions on that archive -> m a withArchive path m = liftIO $ do @@ -327,7 +320,7 @@ getEntry s = sourceEntry s (CL.foldMap id) getEntrySource :: (PrimMonad m, MonadThrow m, MonadResource m) - => EntrySelector + => EntrySelector -- ^ Selector that identifies archive entry -> ZipArchive (ConduitT () ByteString m ()) getEntrySource s = do path <- getFilePath @@ -357,9 +350,9 @@ sourceEntry s sink = do saveEntry :: EntrySelector -- ^ Selector that identifies archive entry - -> Path b File -- ^ Where to save the file + -> FilePath -- ^ Where to save the file -> ZipArchive () -saveEntry s path = sourceEntry s (CB.sinkFile (toFilePath path)) +saveEntry s path = sourceEntry s (CB.sinkFile path) -- | Calculate CRC32 check sum and compare it with the value read from the -- archive. The function returns 'True' when the check sums are the @@ -380,14 +373,14 @@ checkEntry s = do -- | Unpack the entire archive into the specified directory. The directory -- will be created if it does not exist. -unpackInto :: Path b Dir -> ZipArchive () +unpackInto :: FilePath -> ZipArchive () unpackInto dir' = do selectors <- M.keysSet <$> getEntries unless (null selectors) $ do dir <- liftIO (makeAbsolute dir') - liftIO (ensureDir dir) - let dirs = E.map (parent . (dir ) . unEntrySelector) selectors - forM_ dirs (liftIO . ensureDir) + liftIO (createDirectoryIfMissing True dir) + let dirs = E.map (FP.takeDirectory . (dir ) . unEntrySelector) selectors + forM_ dirs (liftIO . createDirectoryIfMissing True) forM_ selectors $ \s -> saveEntry s (dir unEntrySelector s) @@ -426,14 +419,13 @@ sinkEntry t src s = addPending (I.SinkEntry t src s) loadEntry :: CompressionMethod -- ^ Compression method to use - -> (Path Abs File -> ZipArchive EntrySelector) -- ^ How to get 'EntrySelector' - -> Path b File -- ^ Path to file to add + -> EntrySelector -- ^ Name of entry to add + -> FilePath -- ^ Path to file to add -> ZipArchive () -loadEntry t f path = do +loadEntry t s path = do apath <- liftIO (canonicalizePath path) - s <- f apath modTime <- liftIO (getModificationTime path) - let src = CB.sourceFile (toFilePath apath) + let src = CB.sourceFile apath addPending (I.SinkEntry t src s) addPending (I.SetModTime modTime s) @@ -441,9 +433,9 @@ loadEntry t f path = do -- exist in that archive, 'EntryDoesNotExist' will be eventually thrown. copyEntry - :: Path b File -- ^ Path to archive to copy from + :: FilePath -- ^ Path to archive to copy from -> EntrySelector -- ^ Name of entry (in source archive) to copy - -> EntrySelector -- ^ Name of entry to insert (in actual archive) + -> EntrySelector -- ^ Name of entry to insert (in current archive) -> ZipArchive () copyEntry path s' s = do apath <- liftIO (canonicalizePath path) @@ -452,17 +444,20 @@ copyEntry path s' s = do -- | Add an entire directory to the archive. Please note that due to the -- design of the library, empty sub-directories won't be added. -- --- The action can throw the same exceptions as 'listDirRecur' and --- 'InvalidEntrySelector'. +-- The action can throw 'InvalidEntrySelector'. packDirRecur :: CompressionMethod -- ^ Compression method to use - -> (Path Abs File -> ZipArchive EntrySelector) -- ^ How to get 'EntrySelector' - -> Path b Dir -- ^ Path to directory to add + -> (FilePath -> ZipArchive EntrySelector) + -- ^ How to get 'EntrySelector' from a path relative to the root of the + -- directory we pack + -> FilePath -- ^ Path to directory to add -> ZipArchive () packDirRecur t f path = do - files <- snd <$> liftIO (listDirRecur path) - mapM_ (loadEntry t f) files + files <- liftIO (listDirRecur path) + forM_ files $ \x -> do + s <- f x + loadEntry t s (path x) -- | Rename an entry in the archive. If the entry does not exist, nothing -- will happen. @@ -580,7 +575,7 @@ commit = do odesc <- getArchiveDescription oentries <- getEntries actions <- getPending - exists <- doesFileExist file + exists <- liftIO (doesFileExist file) unless (S.null actions && exists) $ do liftIO (I.commit file odesc oentries actions) -- NOTE The most robust way to update internal description of the @@ -599,7 +594,7 @@ commit = do -- | Get the path of the actual archive file from inside of 'ZipArchive' -- monad. -getFilePath :: ZipArchive (Path Abs File) +getFilePath :: ZipArchive FilePath getFilePath = ZipArchive (gets zsFilePath) -- | Get the collection of pending actions. @@ -617,3 +612,34 @@ modifyActions f = ZipArchive (modify g) addPending :: I.PendingAction -> ZipArchive () addPending a = modifyActions (|> a) + +-- | Recursively list a directory. Do not return paths to empty directories. + +listDirRecur :: FilePath -> IO [FilePath] +listDirRecur path = DList.toList <$> go "" + where + go adir = do + let cdir = path adir + raw <- listDirectory cdir + fmap mconcat . forM raw $ \case + "" -> return mempty + "." -> return mempty + ".." -> return mempty + x -> do + let fullx = cdir x + adir' = adir x + isFile <- doesFileExist fullx + isDir <- doesDirectoryExist fullx + if isFile + then return (DList.singleton adir') + else if isDir + then go adir' + else return mempty + +-- | Perform an action ignoring IO exceptions it may throw. + +ignoringAbsence :: IO () -> IO () +ignoringAbsence io = catchJust select io handler + where + select e = if isDoesNotExistError e then Just e else Nothing + handler = const (return ()) diff --git a/Codec/Archive/Zip/Internal.hs b/Codec/Archive/Zip/Internal.hs index 8b75e5c..35b873e 100644 --- a/Codec/Archive/Zip/Internal.hs +++ b/Codec/Archive/Zip/Internal.hs @@ -24,8 +24,9 @@ import Codec.Archive.Zip.CP437 (decodeCP437) import Codec.Archive.Zip.Type import Conduit (PrimMonad) import Control.Applicative (many, (<|>)) +import Control.Exception (bracketOnError) import Control.Monad -import Control.Monad.Catch +import Control.Monad.Catch (MonadThrow (..)) import Control.Monad.Trans.Maybe import Control.Monad.Trans.Resource (ResourceT, MonadResource) import Data.Bits @@ -38,7 +39,6 @@ import Data.Fixed (Fixed (..)) import Data.Foldable (foldl') import Data.Map.Strict (Map, (!)) import Data.Maybe (fromJust, catMaybes, isNothing) -import Data.Monoid ((<>)) import Data.Sequence (Seq, (><), (|>)) import Data.Serialize import Data.Text (Text) @@ -47,9 +47,9 @@ import Data.Version import Data.Void import Data.Word (Word16, Word32) import Numeric.Natural (Natural) -import Path +import System.Directory +import System.FilePath import System.IO -import System.PlanB import qualified Data.ByteString as B import qualified Data.Conduit as C import qualified Data.Conduit.BZlib as BZ @@ -73,7 +73,7 @@ data PendingAction (ConduitT () ByteString (ResourceT IO) ()) EntrySelector -- ^ Add entry given its 'Source' - | CopyEntry (Path Abs File) EntrySelector EntrySelector + | CopyEntry FilePath EntrySelector EntrySelector -- ^ Copy an entry form another archive without re-compression | RenameEntry EntrySelector EntrySelector -- ^ Change name the entry inside archive @@ -100,7 +100,7 @@ data PendingAction -- archive. data ProducingActions = ProducingActions - { paCopyEntry :: Map (Path Abs File) (Map EntrySelector EntrySelector) + { paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector) , paSinkEntry :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ()) } @@ -192,9 +192,9 @@ zipVersion = Version [4,6] [] -- with this library. scanArchive - :: Path Abs File -- ^ Path to archive to scan + :: FilePath -- ^ Path to archive to scan -> IO (ArchiveDescription, Map EntrySelector EntryDescription) -scanArchive path = withBinaryFile (toFilePath path) ReadMode $ \h -> do +scanArchive path = withBinaryFile path ReadMode $ \h -> do mecdOffset <- locateECD path h case mecdOffset of Just ecdOffset -> do @@ -218,7 +218,7 @@ scanArchive path = withBinaryFile (toFilePath path) ReadMode $ \h -> do sourceEntry :: (PrimMonad m, MonadThrow m, MonadResource m) - => Path Abs File -- ^ Path to archive that contains the entry + => FilePath -- ^ Path to archive that contains the entry -> EntryDescription -- ^ Information needed to extract entry of interest -> Bool -- ^ Should we stream uncompressed data? -> ConduitT () ByteString m () -- ^ Source of uncompressed data @@ -226,7 +226,7 @@ sourceEntry path EntryDescription {..} d = source .| CB.isolate (fromIntegral edCompressedSize) .| decompress where source = CB.sourceIOHandle $ do - h <- openFile (toFilePath path) ReadMode + h <- openFile path ReadMode hSeek h AbsoluteSeek (fromIntegral edOffset) localHeader <- B.hGet h 30 case runGet getLocalHeaderGap localHeader of @@ -243,26 +243,41 @@ sourceEntry path EntryDescription {..} d = -- in one pass, and then they are performed in the most efficient way. commit - :: Path Abs File -- ^ Location of archive file to edit or create + :: FilePath -- ^ Location of archive file to edit or create -> ArchiveDescription -- ^ Archive description -> Map EntrySelector EntryDescription -- ^ Current list of entires -> Seq PendingAction -- ^ Collection of pending actions -> IO () commit path ArchiveDescription {..} entries xs = - withNewFile (overrideIfExists <> - nameTemplate ".zip" <> - tempDir (parent path) <> - moveByRenaming) path $ \temp -> do + withNewFile path $ \h -> do let (ProducingActions coping sinking, editing) = optimize (toRecreatingActions path entries >< xs) comment = predictComment adComment xs - withBinaryFile (toFilePath temp) WriteMode $ \h -> do - copiedCD <- M.unions <$> forM (M.keys coping) (\srcPath -> - copyEntries h srcPath (coping ! srcPath) editing) - let sinkingKeys = M.keys $ sinking `M.difference` copiedCD - sunkCD <- M.fromList <$> forM sinkingKeys (\selector -> - sinkEntry h selector GenericOrigin (sinking ! selector) editing) - writeCD h comment (copiedCD `M.union` sunkCD) + copiedCD <- M.unions <$> forM (M.keys coping) (\srcPath -> + copyEntries h srcPath (coping ! srcPath) editing) + let sinkingKeys = M.keys $ sinking `M.difference` copiedCD + sunkCD <- M.fromList <$> forM sinkingKeys (\selector -> + sinkEntry h selector GenericOrigin (sinking ! selector) editing) + writeCD h comment (copiedCD `M.union` sunkCD) + +-- | Create a new file with the guarantee that in case of exception the old +-- file will be preserved intact. The file is only updated\/replaced if the +-- second argument finishes without exceptions. + +withNewFile + :: FilePath -- ^ Name of file to create + -> (Handle -> IO ()) -- ^ Action that writes to given 'Handle' + -> IO () +withNewFile fpath action = + bracketOnError allocate release $ \(path, h) -> do + action h + hClose h + renameFile path fpath + where + allocate = openBinaryTempFile (takeDirectory fpath) ".zip" + release (path, h) = do + hClose h + removeFile path -- | Determine what comment in new archive will look like given its original -- value and a collection of pending actions. @@ -279,7 +294,7 @@ predictComment original xs = -- actions that re-create those entires. toRecreatingActions - :: Path Abs File -- ^ Name of the archive file where entires are found + :: FilePath -- ^ Name of the archive file where entires are found -> Map EntrySelector EntryDescription -- ^ Actual list of entires -> Seq PendingAction -- ^ Actions that recreate the archive entries toRecreatingActions path entries = E.foldl' f S.empty (M.keysSet entries) @@ -360,7 +375,7 @@ optimize = foldl' f copyEntries :: Handle -- ^ Opened 'Handle' of zip archive file - -> Path Abs File -- ^ Path to file from which to copy the entries + -> FilePath -- ^ Path to the file to copy the entries from -> Map EntrySelector EntrySelector -- ^ 'Map' from original name to name to use in new archive -> EditingActions -- ^ Additional info that can influence result @@ -586,8 +601,7 @@ getCDHeader = do , edOffset = z64efOffset z64ef , edComment = if commentSize == 0 then Nothing else comment , edExtraField = extraField } - in return $ (,desc) <$> - (fileName >>= parseRelFile . T.unpack >>= mkEntrySelector) + in return $ (,desc) <$> (fileName >>= mkEntrySelector . T.unpack) -- | Parse an extra-field. @@ -796,7 +810,7 @@ putECD totalCount cdSize cdOffset mcomment = do -- | Find absolute offset of end of central directory record or, if present, -- Zip64 end of central directory record. -locateECD :: Path Abs File -> Handle -> IO (Maybe Integer) +locateECD :: FilePath -> Handle -> IO (Maybe Integer) locateECD path h = sizeCheck where diff --git a/Codec/Archive/Zip/Type.hs b/Codec/Archive/Zip/Type.hs index 52b9c97..3a9a25d 100644 --- a/Codec/Archive/Zip/Type.hs +++ b/Codec/Archive/Zip/Type.hs @@ -7,12 +7,9 @@ -- Stability : experimental -- Portability : portable -- --- Types used by the package. You don't usually need to import this module, --- because "Codec.Archive.Zip" re-exports everything you may need, import --- that module instead. +-- Types used by the package. {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} module Codec.Archive.Zip.Type ( -- * Entry selector @@ -24,13 +21,12 @@ module Codec.Archive.Zip.Type -- * Entry description , EntryDescription (..) , CompressionMethod (..) - -- * Archive desrciption + -- * Archive description , ArchiveDescription (..) -- * Exceptions , ZipException (..) ) where -import Control.Arrow ((>>>)) import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow (..)) import Data.ByteString (ByteString) @@ -38,15 +34,13 @@ import Data.CaseInsensitive (CI) import Data.Data (Data) import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) -import Data.Maybe (mapMaybe, fromJust) +import Data.Maybe (mapMaybe) import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Typeable (Typeable) import Data.Version (Version) import Data.Word (Word16, Word32) -import GHC.Generics (Generic) import Numeric.Natural -import Path import qualified Data.ByteString as B import qualified Data.CaseInsensitive as CI import qualified Data.List.NonEmpty as NE @@ -60,9 +54,9 @@ import qualified System.FilePath.Windows as Windows -- Entry selector -- | This data type serves for naming and selection of archive entries. It --- can be created only with the help of the smart constructor --- 'mkEntrySelector', and it's the only “key” that can be used to select --- files in archive or to name new files. +-- can be created only with help of the smart constructor 'mkEntrySelector', +-- and it's the only “key” that can be used to refer to files in archive or +-- to name new archive entries. -- -- The abstraction is crucial for ensuring that created archives are -- portable across operating systems, file systems, and different platforms. @@ -71,74 +65,73 @@ import qualified System.FilePath.Windows as Windows -- are used to name files inside archive, as it's recommended in the -- specification. It also guarantees that forward slashes are used when the -- path is stored inside archive for compatibility with Unix-like operating --- systems (as it is recommended in the specification). On the other hand, --- in can be rendered as ordinary relative file path in OS-specific format, --- when needed. +-- systems (as recommended in the specification). On the other hand, in can +-- be rendered as an ordinary relative file path in OS-specific format when +-- needed. newtype EntrySelector = EntrySelector { unES :: NonEmpty (CI String) -- ^ Path pieces of relative path inside archive - } deriving (Eq, Ord, Typeable, Data, Generic) + } deriving (Eq, Ord, Typeable) instance Show EntrySelector where show = show . unEntrySelector --- | Create an 'EntrySelector' from @'Path' 'Rel' 'File'@. To avoid problems --- with distribution of the archive, characters that some operating systems --- do not expect in paths are not allowed. Proper paths should pass these --- checks: +-- | Create an 'EntrySelector' from a 'FilePath'. To avoid problems with +-- distribution of the archive, characters that some operating systems do +-- not expect in paths are not allowed. +-- +-- Argument to 'mkEntrySelector' should pass these checks: -- -- * 'System.FilePath.Posix.isValid' -- * 'System.FilePath.Windows.isValid' --- * binary representation of normalized path should be not longer than +-- * it is a relative path without slash at the end +-- * binary representations of normalized path should be not longer than -- 65535 bytes -- -- This function can throw an 'EntrySelectorException'. -mkEntrySelector :: MonadThrow m => Path Rel File -> m EntrySelector +mkEntrySelector :: MonadThrow m => FilePath -> m EntrySelector mkEntrySelector path = - let fp = toFilePath path - g x = if null x then Nothing else Just (CI.mk x) - preparePiece = g . filter (not . FP.isPathSeparator) - pieces = mapMaybe preparePiece (FP.splitPath fp) - selector = EntrySelector (NE.fromList pieces) - binLength = B.length . T.encodeUtf8 . getEntryName - in if Posix.isValid fp && - Windows.isValid fp && - fp /= "." && -- work around a bug in the path package - not (null pieces) && - binLength selector <= 0xffff - then return selector - else throwM (InvalidEntrySelector path) - --- | Make a relative path from 'EntrySelector'. Every 'EntrySelector' --- produces a single @'Path' 'Rel' 'File'@ that corresponds to it. - -unEntrySelector :: EntrySelector -> Path Rel File -unEntrySelector = unES - >>> NE.toList - >>> fmap CI.original - >>> FP.joinPath - >>> parseRelFile - >>> fromJust + let f x = + case filter (not . FP.isPathSeparator) x of + [] -> Nothing + xs -> Just (CI.mk xs) + giveup = throwM (InvalidEntrySelector path) + in case NE.nonEmpty (mapMaybe f (FP.splitPath path)) of + Nothing -> giveup + Just pieces -> + let selector = EntrySelector pieces + binLength = B.length . T.encodeUtf8 . getEntryName + in if Posix.isValid path && + Windows.isValid path && + not (FP.isAbsolute path || FP.hasTrailingPathSeparator path) && + (CI.mk "." `notElem` pieces) && + (CI.mk ".." `notElem` pieces) && + binLength selector <= 0xffff + then return selector + else giveup + +-- | Restore a relative path from 'EntrySelector'. Every 'EntrySelector' +-- corresponds to a single 'FilePath'. + +unEntrySelector :: EntrySelector -> FilePath +unEntrySelector = + FP.joinPath . fmap CI.original . NE.toList . unES -- | Get an entry name in the from that is suitable for writing to file -- header, given an 'EntrySelector'. getEntryName :: EntrySelector -> Text -getEntryName = unES - >>> fmap CI.original - >>> NE.intersperse "/" - >>> NE.toList - >>> concat - >>> T.pack - --- | The exception describing various troubles you can have with +getEntryName = + T.pack . concat . NE.toList . NE.intersperse "/" . fmap CI.original . unES + +-- | The exception represents various troubles you can have with -- 'EntrySelector'. data EntrySelectorException - = InvalidEntrySelector (Path Rel File) - -- ^ Selector cannot be created from this path + = InvalidEntrySelector FilePath + -- ^ 'EntrySelector' cannot be created from this path deriving (Eq, Ord, Typeable) instance Show EntrySelectorException where @@ -151,8 +144,8 @@ instance Exception EntrySelectorException -- | This record represents all information about archive entry that can be -- stored in a zip archive. It does not mirror local file header or central --- directory file header, but their binary representation can be built given --- this data structure and the actual archive contents. +-- directory file header, but their binary representations can be built +-- given this data structure and the actual archive contents. data EntryDescription = EntryDescription { edVersionMadeBy :: Version -- ^ Version made by @@ -192,9 +185,9 @@ data ArchiveDescription = ArchiveDescription -- | The bad things that can happen when you use the library. data ZipException - = EntryDoesNotExist (Path Abs File) EntrySelector + = EntryDoesNotExist FilePath EntrySelector -- ^ Thrown when you try to get contents of non-existing entry - | ParsingFailed (Path Abs File) String + | ParsingFailed FilePath String -- ^ Thrown when archive structure cannot be parsed deriving (Eq, Ord, Typeable) diff --git a/README.md b/README.md index 7c569c6..ae5bb21 100644 --- a/README.md +++ b/README.md @@ -165,13 +165,10 @@ The module `Codec.Archive.Zip` provides everything you may need to manipulate Zip archives. There are three things that should be clarified right away, to avoid confusion in the future. -First, we use the `EntrySelector` type that can be obtained from `Path Rel -File` paths. This method may seem awkward at first, but it will protect you -from the problems with portability when your archive is unpacked on a -different platform. Using well-typed paths is also something you should -consider doing in your projects anyway. Even if you don't want to use the -`Path` module in your project, it's easy to marshal `FilePath` to `Path` -just before using functions from the library. +First, we use the `EntrySelector` type that can be obtained from relative +`FilePath`s (paths to directories are not allowed). This method may seem +awkward at first, but it will protect you from the problems with portability +when your archive is unpacked on a different platform. The second thing, that is rather a consequence of the first, is that there is no way to add directories, or to be precise, *empty directories* to your @@ -239,7 +236,7 @@ You can stream from `Source` as well: To add contents from a file, use `loadEntry`: ```haskell -λ> let toSelector = const $ parseRelFile "my-entry.txt" >>= mkEntrySelector +λ> let toSelector = const (mkEntrySelector "my-entry.txt") λ> createArchive archivePath (loadEntry BZip2 toSelector myFilePath) ``` @@ -253,8 +250,7 @@ Finally, you can copy an entry from another archive without re-compression It's often desirable to just pack a directory: ```haskell -λ> let f = stripDir dir >=> mkEntrySelector -λ> createArchive archivePath (packDirRecur Deflate f dir) +λ> createArchive archivePath (packDirRecur Deflate mkEntrySelector dir) ``` It's also possible to: diff --git a/stack.yaml b/stack.yaml index d3afca8..af1d7fa 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,3 +1,9 @@ resolver: lts-10.0 packages: - '.' +extra-deps: +- bzlib-conduit-0.3.0 +- conduit-1.3.0 +- conduit-extra-1.3.0 +- mono-traversable-1.0.8.1 +- resourcet-1.2.0 diff --git a/tests/Main.hs b/tests/Main.hs index c43a848..994f758 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS -fno-warn-orphans #-} module Main (main) where @@ -9,11 +9,9 @@ module Main (main) where import Codec.Archive.Zip import Codec.Archive.Zip.CP437 import Control.Monad -import Control.Monad.Catch (catchIOError) import Control.Monad.IO.Class import Data.Bits (complement) import Data.ByteString (ByteString) -import Data.Foldable (foldl') import Data.List (intercalate) import Data.Map (Map, (!)) import Data.Maybe (fromJust) @@ -21,10 +19,11 @@ import Data.Monoid import Data.Text (Text) import Data.Time import Data.Version -import Path -import Path.IO +import System.Directory +import System.FilePath (()) import System.IO import System.IO.Error (isDoesNotExistError) +import System.IO.Temp import Test.Hspec import Test.QuickCheck import qualified Data.ByteString as B @@ -32,11 +31,12 @@ import qualified Data.ByteString.Builder as LB import qualified Data.ByteString.Lazy as LB import qualified Data.Conduit as C import qualified Data.Conduit.List as CL -import qualified Data.Map as M +import qualified Data.DList as DList +import qualified Data.Map.Strict as M import qualified Data.Set as E import qualified Data.Text as T import qualified Data.Text.Encoding as T -import qualified System.FilePath.Windows as Windows +import qualified System.FilePath as FP -- | Zip tests. Please note that Zip64 feature is not currently tested -- automatically because for it to expose itself we need > 4GB of @@ -91,16 +91,23 @@ instance Arbitrary UTCTime where <$> (ModifiedJulianDay <$> choose (44239, 90989)) <*> (secondsToDiffTime <$> choose (0, 86399)) -instance Arbitrary (Path Rel File) where +newtype RelPath = RelPath FilePath + +instance Show RelPath where + show (RelPath path) = show path + +instance Arbitrary RelPath where arbitrary = do - x <- intercalate "/" <$> listOf1 (listOf1 charGen) - case parseRelFile x of + p <- intercalate "/" <$> listOf1 + ((++) <$> vectorOf 3 charGen + <*> listOf1 charGen) + case mkEntrySelector p of Nothing -> arbitrary - Just path -> return path + Just _ -> return (RelPath p) instance Arbitrary EntrySelector where arbitrary = do - x <- arbitrary + RelPath x <- arbitrary case mkEntrySelector x of Nothing -> arbitrary Just s -> return s @@ -137,8 +144,10 @@ instance Arbitrary EM where data EC = EC (Map EntrySelector EntryDescription) (ZipArchive ()) deriving Show instance Arbitrary EC where - arbitrary = foldl' f (EC M.empty (return ())) <$> listOf1 arbitrary - where f (EC m z') (EM s desc z) = EC (M.insert s desc m) (z' >> z) + arbitrary = do + let f (EM s d z) = (s, (d, z)) + m <- M.fromList . fmap f <$> listOf arbitrary + return (EC (M.map fst m) (sequence_ $ snd <$> M.elems m)) charGen :: Gen Char charGen = frequency @@ -169,27 +178,43 @@ instance Show (ZipArchive a) where mkEntrySelectorSpec :: Spec mkEntrySelectorSpec = do - context "when incorrect Windows paths are passed" $ - it "rejects them" . property $ \path -> - (not . Windows.isValid . toFilePath $ path) - ==> mkEntrySelector path === Nothing + let rejects x = + mkEntrySelector x `shouldThrow` isEntrySelectorException x + accepts x = do + s <- mkEntrySelector x + getEntryName s `shouldBe` T.pack x + context "when absolute paths are passed" $ + it "they are rejected" $ property $ \(RelPath x) -> + rejects ('/' : x) + context "when paths with trailing path separator are passed" $ + it "they are rejected" $ do + rejects "foo/" + rejects "foo/bar/" + context "when paths with dot as path segment are passed" $ + it "they are rejected" $ do + rejects "./foo/bar" + rejects "foo/./bar" + rejects "foo/bar/." + context "when paths with double dot as path segment are passed" $ + it "they are rejected" $ do + rejects "../foo/bar" + rejects "foo/../bar" + rejects "foo/bar/.." context "when too long paths are passed" $ it "rejects them" $ do - path <- parseRelFile (replicate 0x10000 'a') + let path = replicate 0x10000 'a' mkEntrySelector path `shouldThrow` isEntrySelectorException path context "when correct paths are passed" $ it "adequately represents them" $ do - let c str = do - s <- parseRelFile str >>= mkEntrySelector - getEntryName s `shouldBe` T.pack str - c "one/two/three" - c "something.txt" + accepts "foo" + accepts "one/two/three" + accepts "something.txt" unEntrySelectorSpec :: Spec unEntrySelectorSpec = context "when entry selector exists" $ it "has corresponding path" . property $ \s -> - not . null . toFilePath . unEntrySelector $ s + not . null . unEntrySelector $ s getEntryNameSpec :: Spec getEntryNameSpec = @@ -214,36 +239,36 @@ decodeCP437Spec = do ---------------------------------------------------------------------------- -- Primitive editing/querying actions -createArchiveSpec :: SpecWith (Path Abs File) +createArchiveSpec :: SpecWith FilePath createArchiveSpec = do context "when called with non-existent path and empty recipe" $ it "creates correct representation of empty archive" $ \path -> do createArchive path (return ()) - B.readFile (toFilePath path) `shouldReturn` emptyArchive - context "when called with occupied path" $ + B.readFile path `shouldReturn` emptyArchive + context "when called with an occupied path" $ it "overwrites it" $ \path -> do - B.writeFile (toFilePath path) B.empty + B.writeFile path B.empty createArchive path (return ()) - B.readFile (toFilePath path) `shouldNotReturn` B.empty + B.readFile path `shouldNotReturn` B.empty -withArchiveSpec :: SpecWith (Path Abs File) +withArchiveSpec :: SpecWith FilePath withArchiveSpec = do context "when called with non-existent path" $ it "throws 'isDoesNotExistError' exception" $ \path -> withArchive path (return ()) `shouldThrow` isDoesNotExistError context "when called with occupied path (empty file)" $ it "throws 'ParsingFailed' exception" $ \path -> do - B.writeFile (toFilePath path) B.empty + B.writeFile path B.empty withArchive path (return ()) `shouldThrow` isParsingFailed path "Cannot locate end of central directory" context "when called with occupied path (empty archive)" $ it "does not overwrite the file unnecessarily" $ \path -> do - let fp = toFilePath path - B.writeFile fp emptyArchive - withArchive path . liftIO $ B.writeFile fp B.empty - B.readFile fp `shouldNotReturn` emptyArchive + B.writeFile path emptyArchive + withArchive path $ + liftIO $ B.writeFile path B.empty + B.readFile path `shouldNotReturn` emptyArchive -archiveCommentSpec :: SpecWith (Path Abs File) +archiveCommentSpec :: SpecWith FilePath archiveCommentSpec = do context "when new archive is created" $ it "returns no archive comment" $ \path -> @@ -290,14 +315,14 @@ archiveCommentSpec = do getArchiveComment comment `shouldBe` Nothing -getEntryDescSpec :: SpecWith (Path Abs File) +getEntryDescSpec :: SpecWith FilePath getEntryDescSpec = it "always returns correct description" $ \path -> property $ \(EM s desc z) -> do desc' <- fromJust <$> createArchive path (z >> commit >> getEntryDesc s) desc' `shouldSatisfy` softEq desc -versionNeededSpec :: SpecWith (Path Abs File) +versionNeededSpec :: SpecWith FilePath versionNeededSpec = it "writes correct version that is needed to extract archive" $ -- NOTE for now we check only how version depends on compression method, @@ -310,7 +335,7 @@ versionNeededSpec = Deflate -> [2,0] BZip2 -> [4,6]) -addEntrySpec :: SpecWith (Path Abs File) +addEntrySpec :: SpecWith FilePath addEntrySpec = context "when an entry is added" $ it "is there" $ \path -> property $ \m b s -> do @@ -320,7 +345,7 @@ addEntrySpec = (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) info `shouldBe` (b, m) -sinkEntrySpec :: SpecWith (Path Abs File) +sinkEntrySpec :: SpecWith FilePath sinkEntrySpec = context "when an entry is sunk" $ it "is there" $ \path -> property $ \m b s -> do @@ -331,20 +356,20 @@ sinkEntrySpec = <*> (edCompression . (! s) <$> getEntries) info `shouldBe` (b, m) -loadEntrySpec :: SpecWith (Path Abs File) +loadEntrySpec :: SpecWith FilePath loadEntrySpec = context "when an entry is loaded" $ it "is there" $ \path -> property $ \m b s -> do let vpath = deriveVacant path - B.writeFile (toFilePath vpath) b + B.writeFile vpath b createArchive path $ do - loadEntry m (const $ return s) vpath + loadEntry m s vpath commit liftIO (removeFile vpath) saveEntry s vpath - B.readFile (toFilePath vpath) `shouldReturn` b + B.readFile vpath `shouldReturn` b -copyEntrySpec :: SpecWith (Path Abs File) +copyEntrySpec :: SpecWith FilePath copyEntrySpec = context "when entry is copied form another archive" $ it "is there" $ \path -> property $ \m b s -> do @@ -356,7 +381,7 @@ copyEntrySpec = (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) info `shouldBe` (b, m) -checkEntrySpec :: SpecWith (Path Abs File) +checkEntrySpec :: SpecWith FilePath checkEntrySpec = do context "when entry is intact" $ it "passes the check" $ \path -> property $ \m b s -> do @@ -373,14 +398,14 @@ checkEntrySpec = do addEntry Store b s commit fromIntegral . edOffset . (! s) <$> getEntries - withFile (toFilePath path) ReadWriteMode $ \h -> do + withFile path ReadWriteMode $ \h -> do hSeek h AbsoluteSeek (offset + fromIntegral r) byte <- B.map complement <$> B.hGet h 1 hSeek h RelativeSeek (-1) B.hPut h byte withArchive path (checkEntry s) `shouldReturn` False -recompressSpec :: SpecWith (Path Abs File) +recompressSpec :: SpecWith FilePath recompressSpec = context "when recompression is used" $ it "gets recompressed" $ \path -> property $ \m m' b s -> do @@ -392,7 +417,7 @@ recompressSpec = (,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries) info `shouldBe` (b, m') -entryCommentSpec :: SpecWith (Path Abs File) +entryCommentSpec :: SpecWith FilePath entryCommentSpec = do context "when comment is committed (delete/set)" $ it "reads it and updates" $ \path -> property $ \txt s -> do @@ -433,7 +458,7 @@ entryCommentSpec = do edComment . (! s) <$> getEntries comment `shouldBe` Nothing -setModTimeSpec :: SpecWith (Path Abs File) +setModTimeSpec :: SpecWith FilePath setModTimeSpec = do context "when mod time is set (after creation)" $ it "reads it and updates" $ \path -> property $ \time s -> do @@ -453,7 +478,7 @@ setModTimeSpec = do edModTime . (! s) <$> getEntries modTime `shouldNotSatisfy` isCloseTo time -extraFieldSpec :: SpecWith (Path Abs File) +extraFieldSpec :: SpecWith FilePath extraFieldSpec = do context "when extra field is committed (delete/set)" $ it "reads it and updates" $ \path -> property $ \n b s -> @@ -498,7 +523,7 @@ extraFieldSpec = do M.lookup n . edExtraField . (! s) <$> getEntries efield `shouldBe` Nothing -renameEntrySpec :: SpecWith (Path Abs File) +renameEntrySpec :: SpecWith FilePath renameEntrySpec = do context "when renaming after editing of new entry" $ it "produces correct result" $ \path -> property $ \(EM s desc z) s' -> do @@ -518,7 +543,7 @@ renameEntrySpec = do (! s') <$> getEntries desc' `shouldSatisfy` softEq desc -deleteEntrySpec :: SpecWith (Path Abs File) +deleteEntrySpec :: SpecWith FilePath deleteEntrySpec = do context "when deleting after editing of new entry" $ it "produces correct result" $ \path -> property $ \(EM s _ z) -> do @@ -538,7 +563,7 @@ deleteEntrySpec = do doesEntryExist s member `shouldBe` False -forEntriesSpec :: SpecWith (Path Abs File) +forEntriesSpec :: SpecWith FilePath forEntriesSpec = it "affects all existing entries" $ \path -> property $ \(EC m z) txt -> do m' <- createArchive path $ do @@ -550,7 +575,7 @@ forEntriesSpec = let f ed = ed { edComment = Just txt } m' `shouldSatisfy` softEqMap (M.map f m) -undoEntryChangesSpec :: SpecWith (Path Abs File) +undoEntryChangesSpec :: SpecWith FilePath undoEntryChangesSpec = it "cancels all actions for specified entry" $ \path -> property $ \(EM s _ z) -> do @@ -561,7 +586,7 @@ undoEntryChangesSpec = doesEntryExist s member `shouldBe` False -undoArchiveChangesSpec :: SpecWith (Path Abs File) +undoArchiveChangesSpec :: SpecWith FilePath undoArchiveChangesSpec = do it "cancels archive comment editing" $ \path -> property $ \txt -> do comment <- createArchive path $ do @@ -580,22 +605,21 @@ undoArchiveChangesSpec = do getArchiveComment comment `shouldBe` Just txt -undoAllSpec :: SpecWith (Path Abs File) +undoAllSpec :: SpecWith FilePath undoAllSpec = it "cancels all editing at once" $ \path -> property $ \(EC _ z) txt -> do - let fp = toFilePath path createArchive path (return ()) withArchive path $ do z setArchiveComment txt undoAll - liftIO (B.writeFile fp B.empty) - B.readFile fp `shouldReturn` B.empty + liftIO (B.writeFile path B.empty) + B.readFile path `shouldReturn` B.empty ---------------------------------------------------------------------------- -- Complex construction/restoration -consistencySpec :: SpecWith (Path Abs File) +consistencySpec :: SpecWith FilePath consistencySpec = it "can save and restore arbitrary archive" $ \path -> property $ \(EC m z) txt -> do @@ -607,49 +631,35 @@ consistencySpec = txt' `shouldBe` Just txt m' `shouldSatisfy` softEqMap m -packDirRecurSpec :: SpecWith (Path Abs File) +packDirRecurSpec :: SpecWith FilePath packDirRecurSpec = it "packs arbitrary directory recursively" $ - \path -> property $ \contents -> do - let dir = parent path -#if MIN_VERSION_path(0,6,0) - f = stripProperPrefix dir >=> mkEntrySelector -#else - f = stripDir dir >=> mkEntrySelector -#endif - - blew <- catchIOError (do + \path -> property $ \contents -> + withSystemTempDirectory "zip-sandbox" $ \dir -> do forM_ contents $ \s -> do let item = dir unEntrySelector s - ensureDir (parent item) - B.writeFile (toFilePath item) "foo" - return False) - (const $ return True) - when blew discard -- TODO - selectors <- M.keysSet <$> - createArchive path (packDirRecur Store f dir >> commit >> getEntries) - selectors `shouldBe` E.fromList contents - -unpackIntoSpec :: SpecWith (Path Abs File) + createDirectoryIfMissing True (FP.takeDirectory item) + B.writeFile item "foo" + selectors <- + createArchive path $ do + packDirRecur Store mkEntrySelector dir + commit + M.keysSet <$> getEntries + selectors `shouldBe` E.fromList contents + +unpackIntoSpec :: SpecWith FilePath unpackIntoSpec = it "unpacks archive contents into directory" $ - \path -> property $ \(EC m z) -> do - let dir = parent path - blew <- createArchive path $ do - z - commit - catchIOError - (unpackInto dir >> return False) - (const $ return True) - when blew discard -- TODO - removeFile path - selectors <- listDirRecur dir >>= -#if MIN_VERSION_path(0,6,0) - mapM (stripProperPrefix dir >=> mkEntrySelector) . snd -#else - mapM (stripDir dir >=> mkEntrySelector) . snd -#endif - E.fromList selectors `shouldBe` M.keysSet m + \path -> property $ \(EC m z) -> + withSystemTempDirectory "zip-sandbox" $ \dir -> do + createArchive path $ do + z + commit + unpackInto dir + selectors <- listDirRecur dir >>= mapM mkEntrySelector + let x = E.fromList selectors + y = M.keysSet m + E.difference x y `shouldBe` E.empty ---------------------------------------------------------------------------- -- Helpers @@ -657,13 +667,13 @@ unpackIntoSpec = -- | Check whether given exception is 'EntrySelectorException' with specific -- path inside. -isEntrySelectorException :: Path Rel File -> EntrySelectorException -> Bool +isEntrySelectorException :: FilePath -> EntrySelectorException -> Bool isEntrySelectorException path (InvalidEntrySelector p) = p == path -- | Check whether given exception is 'ParsingFailed' exception with -- specific path and error message inside. -isParsingFailed :: Path Abs File -> String -> ZipException -> Bool +isParsingFailed :: FilePath -> String -> ZipException -> Bool isParsingFailed path msg (ParsingFailed path' msg') = path == path' && msg == msg' isParsingFailed _ _ _ = False @@ -673,15 +683,15 @@ isParsingFailed _ _ _ = False -- case to avoid contamination and it's unconditionally deleted after test -- case finishes. The function returns vacant file path in that directory. -withSandbox :: ActionWith (Path Abs File) -> IO () -withSandbox action = withSystemTempDir "zip-sandbox" $ \dir -> - action (dir $(mkRelFile "foo.zip")) +withSandbox :: ActionWith FilePath -> IO () +withSandbox action = withSystemTempDirectory "zip-sandbox" $ \dir -> + action (dir "foo.zip") -- | Given primary name (name of archive), generate a name that does not -- collide with it. -deriveVacant :: Path Abs File -> Path Abs File -deriveVacant = ( $(mkRelFile "bar")) . parent +deriveVacant :: FilePath -> FilePath +deriveVacant = ( "bar") . FP.takeDirectory -- | Compare times forgiving minor difference. @@ -714,3 +724,26 @@ emptyArchive :: ByteString emptyArchive = B.pack [ 0x50, 0x4b, 0x05, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 , 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ] + +-- | Recursively list a directory. Do not return paths to empty directories. + +listDirRecur :: FilePath -> IO [FilePath] +listDirRecur path = DList.toList <$> go "" + where + go adir = do + let cdir = path adir + raw <- listDirectory cdir + fmap mconcat . forM raw $ \case + "" -> return mempty + "." -> return mempty + ".." -> return mempty + x -> do + let fullx = cdir x + adir' = adir x + isFile <- doesFileExist fullx + isDir <- doesDirectoryExist fullx + if isFile + then return (DList.singleton adir') + else if isDir + then go adir' + else return mempty diff --git a/zip.cabal b/zip.cabal index 9449499..6763716 100644 --- a/zip.cabal +++ b/zip.cabal @@ -30,13 +30,12 @@ library , conduit-extra >= 1.3 && < 1.4 , containers >= 0.5.6.2 && < 0.6 , digest < 0.1 + , directory >= 1.2.2 && < 1.4 + , dlist >= 0.8 && < 0.9 , exceptions >= 0.6 && < 0.9 , filepath >= 1.2 && < 1.5 , monad-control >= 1.0 && < 1.1 , mtl >= 2.0 && < 3.0 - , path >= 0.5 && < 0.7 - , path-io >= 1.0.1 && < 2.0 - , plan-b >= 0.2 && < 0.3 , resourcet >= 1.2 && < 1.3 , text >= 0.2 && < 1.3 , time >= 1.4 && < 1.9 @@ -48,8 +47,8 @@ library , TupleSections exposed-modules: Codec.Archive.Zip , Codec.Archive.Zip.CP437 - , Codec.Archive.Zip.Type other-modules: Codec.Archive.Zip.Internal + , Codec.Archive.Zip.Type if flag(dev) ghc-options: -O0 -Wall -Werror else @@ -65,11 +64,12 @@ test-suite tests , bytestring >= 0.9 && < 0.11 , conduit >= 1.3 && < 1.4 , containers >= 0.5.6.2 && < 0.6 + , directory >= 1.2.2 && < 1.4 + , dlist >= 0.8 && < 0.9 , exceptions >= 0.6 && < 0.9 , filepath >= 1.2 && < 1.5 , hspec >= 2.0 && < 3.0 - , path >= 0.5 && < 0.7 - , path-io >= 1.0.1 && < 2.0 + , temporary >= 1.1 && < 1.3 , text >= 0.2 && < 1.3 , time >= 1.4 && < 1.9 , transformers >= 0.4 && < 0.6