zip 0.2.0 → 1.0.0
raw patch · 9 files changed
+377/−290 lines, 9 filesdep +directorydep +dlistdep +temporarydep −pathdep −path-iodep −plan-bdep ~basedep ~bzlib-conduitdep ~conduit
Dependencies added: directory, dlist, temporary
Dependencies removed: path, path-io, plan-b
Dependency ranges changed: base, bzlib-conduit, conduit, conduit-extra, exceptions, resourcet
Files
- CHANGELOG.md +18/−0
- Codec/Archive/Zip.hs +83/−55
- Codec/Archive/Zip/CP437.hs +1/−1
- Codec/Archive/Zip/Internal.hs +57/−38
- Codec/Archive/Zip/Type.hs +51/−58
- LICENSE.md +1/−1
- README.md +7/−11
- tests/Main.hs +138/−105
- zip.cabal +21/−21
CHANGELOG.md view
@@ -1,3 +1,21 @@+## 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`
Codec/Archive/Zip.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Codec.Archive.Zip--- Copyright : © 2016–2017 Mark Karpov+-- Copyright : © 2016–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -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 #-} @@ -143,6 +133,7 @@ where import Codec.Archive.Zip.Type+import Conduit (PrimMonad) import Control.Monad import Control.Monad.Base (MonadBase (..)) import Control.Monad.Catch@@ -150,21 +141,25 @@ import Control.Monad.Trans.Control (MonadBaseControl (..)) import Control.Monad.Trans.Resource (ResourceT, MonadResource) import Data.ByteString (ByteString)-import Data.Conduit (Source, Sink, (.|))+import Data.Conduit (ConduitT, (.|)) import Data.Map.Strict (Map, (!)) import Data.Sequence (Seq, (|>)) 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@@ -205,8 +200,8 @@ -- @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@@ -221,7 +216,7 @@ -- 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@@ -261,7 +256,7 @@ -- 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@@ -324,9 +319,9 @@ -- @since 0.1.3 getEntrySource- :: MonadResource m- => EntrySelector- -> ZipArchive (Source m ByteString)+ :: (PrimMonad m, MonadThrow m, MonadResource m)+ => EntrySelector -- ^ Selector that identifies archive entry+ -> ZipArchive (ConduitT () ByteString m ()) getEntrySource s = do path <- getFilePath mdesc <- M.lookup s <$> getEntries@@ -341,7 +336,7 @@ sourceEntry :: EntrySelector -- ^ Selector that identifies archive entry- -> Sink ByteString (ResourceT IO) a+ -> ConduitT ByteString Void (ResourceT IO) a -- ^ Sink where to stream entry contents -> ZipArchive a -- ^ Contents of the entry (if found)@@ -355,9 +350,9 @@ 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@@ -378,14 +373,14 @@ -- | 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) @@ -415,7 +410,7 @@ sinkEntry :: CompressionMethod -- ^ Compression method to use- -> Source (ResourceT IO) ByteString -- ^ Source of entry contents+ -> ConduitT () ByteString (ResourceT IO) () -- ^ Source of entry contents -> EntrySelector -- ^ Name of entry to add -> ZipArchive () sinkEntry t src s = addPending (I.SinkEntry t src s)@@ -424,14 +419,13 @@ 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) @@ -439,9 +433,9 @@ -- 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)@@ -450,17 +444,20 @@ -- | 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.@@ -578,7 +575,7 @@ 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@@ -597,7 +594,7 @@ -- | 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.@@ -615,3 +612,34 @@ 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 ())
Codec/Archive/Zip/CP437.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Codec.Archive.Zip.CP437--- Copyright : © 2016–2017 Mark Karpov+-- Copyright : © 2016–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>
Codec/Archive/Zip/Internal.hs view
@@ -1,6 +1,6 @@ -- | -- Module : Codec.Archive.Zip.Internal--- Copyright : © 2016–2017 Mark Karpov+-- Copyright : © 2016–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -22,32 +22,34 @@ 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 import Data.Bool (bool) import Data.ByteString (ByteString) import Data.Char (ord)-import Data.Conduit (Conduit, Source, Sink, (.|), ZipSink (..))+import Data.Conduit (ConduitT, (.|), ZipSink (..)) import Data.Digest.CRC32 (crc32Update) 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) import Data.Time 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@@ -67,9 +69,11 @@ -- archive. data PendingAction- = SinkEntry CompressionMethod (Source (ResourceT IO) ByteString) EntrySelector+ = SinkEntry CompressionMethod+ (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@@ -96,8 +100,9 @@ -- archive. data ProducingActions = ProducingActions- { paCopyEntry :: Map (Path Abs File) (Map EntrySelector EntrySelector)- , paSinkEntry :: Map EntrySelector (Source (ResourceT IO) ByteString) }+ { paCopyEntry :: Map FilePath (Map EntrySelector EntrySelector)+ , paSinkEntry :: Map EntrySelector (ConduitT () ByteString (ResourceT IO) ())+ } -- | Collection of editing actions, that is, actions that modify already -- existing entries.@@ -187,9 +192,9 @@ -- 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@@ -212,16 +217,16 @@ -- compressed or uncompressed depending on the third argument. sourceEntry- :: MonadResource m- => Path Abs File -- ^ Path to archive that contains the entry+ :: (PrimMonad m, MonadThrow m, MonadResource m)+ => FilePath -- ^ Path to archive that contains the entry -> EntryDescription -- ^ Information needed to extract entry of interest -> Bool -- ^ Should we stream uncompressed data?- -> Source m ByteString -- ^ Source of uncompressed data+ -> ConduitT () ByteString m () -- ^ Source of uncompressed data 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@@ -238,27 +243,42 @@ -- 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. @@ -274,7 +294,7 @@ -- 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)@@ -355,7 +375,7 @@ 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@@ -377,7 +397,7 @@ :: Handle -- ^ Opened 'Handle' of zip archive file -> EntrySelector -- ^ Name of entry to add -> EntryOrigin -- ^ Origin of entry (can contain additional info)- -> Source (ResourceT IO) ByteString -- ^ Source of entry contents+ -> ConduitT () ByteString (ResourceT IO) () -- ^ Source of entry contents -> EditingActions -- ^ Additional info that can influence result -> IO (EntrySelector, EntryDescription) -- ^ Info to generate central directory file headers later@@ -449,7 +469,7 @@ sinkData :: Handle -- ^ Opened 'Handle' of zip archive file -> CompressionMethod -- ^ Compression method to apply- -> Sink ByteString (ResourceT IO) DataDescriptor+ -> ConduitT ByteString Void (ResourceT IO) DataDescriptor -- ^ 'Sink' where to stream data sinkData h compression = do let sizeSink = CL.fold (\acc input -> fromIntegral (B.length input) + acc) 0@@ -581,8 +601,7 @@ , 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. @@ -791,7 +810,7 @@ -- | 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 @@ -969,16 +988,16 @@ -- method. decompressingPipe- :: MonadResource m+ :: (PrimMonad m, MonadThrow m, MonadResource m) => CompressionMethod- -> Conduit ByteString m ByteString+ -> ConduitT ByteString ByteString m () decompressingPipe Store = C.awaitForever C.yield decompressingPipe Deflate = Z.decompress $ Z.WindowBits (-15) decompressingPipe BZip2 = BZ.bunzip2 -- | Sink that calculates CRC32 check sum for incoming stream. -crc32Sink :: Sink ByteString (ResourceT IO) Word32+crc32Sink :: ConduitT ByteString Void (ResourceT IO) Word32 crc32Sink = CL.fold crc32Update 0 -- | Convert 'UTCTime' to MS-DOS time format.
Codec/Archive/Zip/Type.hs view
@@ -1,18 +1,15 @@ -- | -- Module : Codec.Archive.Zip.Type--- Copyright : © 2016–2017 Mark Karpov+-- Copyright : © 2016–2018 Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com> -- 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 @@ -- * 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.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 @@ -- 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 @@ -- 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)+ 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 --- | Make a relative path from 'EntrySelector'. Every 'EntrySelector'--- produces a single @'Path' 'Rel' 'File'@ that corresponds to it.+-- | Restore a relative path from 'EntrySelector'. Every 'EntrySelector'+-- corresponds to a single 'FilePath'. -unEntrySelector :: EntrySelector -> Path Rel File-unEntrySelector = unES- >>> NE.toList- >>> fmap CI.original- >>> FP.joinPath- >>> parseRelFile- >>> fromJust+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+getEntryName =+ T.pack . concat . NE.toList . NE.intersperse "/" . fmap CI.original . unES --- | The exception describing various troubles you can have with+-- | 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 @@ -- | 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 @@ -- | 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)
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2016–2017 Mark Karpov+Copyright © 2016–2018 Mark Karpov All rights reserved.
README.md view
@@ -165,13 +165,10 @@ 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 @@ 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 @@ 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:@@ -282,6 +278,6 @@ ## License -Copyright © 2016–2017 Mark Karpov+Copyright © 2016–2018 Mark Karpov Distributed under BSD 3 clause license.
tests/Main.hs view
@@ -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 @@ 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.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.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 @@ <$> (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 @@ 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 @@ 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 @@ ---------------------------------------------------------------------------- -- 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 @@ 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 @@ 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 @@ (,) <$> 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 @@ <*> (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 @@ (,) <$> 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 @@ 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 @@ (,) <$> 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 @@ 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 @@ 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 @@ 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 @@ (! 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 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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+ 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 (Path Abs File)+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 @@ -- | 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 @@ -- 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 = 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
zip.cabal view
@@ -1,7 +1,7 @@ name: zip-version: 0.2.0+version: 1.0.0 cabal-version: >= 1.18-tested-with: GHC==7.10.3, GHC==8.0.2, GHC==8.2.1+tested-with: GHC==8.0.2, GHC==8.2.2 license: BSD3 license-file: LICENSE.md author: Mark Karpov <markkarpov92@gmail.com>@@ -21,23 +21,22 @@ default: False library- build-depends: base >= 4.8 && < 5.0+ build-depends: base >= 4.9 && < 5.0 , bytestring >= 0.9 && < 0.11- , bzlib-conduit >= 0.2 && < 0.3+ , bzlib-conduit >= 0.3 && < 0.4 , case-insensitive >= 1.2.0.2 && < 1.3 , cereal >= 0.3 && < 0.6- , conduit >= 1.2.8 && < 2.0- , conduit-extra >= 1.1 && < 2.0+ , conduit >= 1.3 && < 1.4+ , 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.0 && < 2.0+ , resourcet >= 1.2 && < 1.3 , text >= 0.2 && < 1.3 , time >= 1.4 && < 1.9 , transformers >= 0.4 && < 0.6@@ -48,10 +47,10 @@ , 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: -Wall -Werror+ ghc-options: -O0 -Wall -Werror else ghc-options: -O2 -Wall default-language: Haskell2010@@ -60,24 +59,25 @@ main-is: Main.hs hs-source-dirs: tests type: exitcode-stdio-1.0- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -O2 -Wall- build-depends: base >= 4.8 && < 5.0+ build-depends: base >= 4.9 && < 5.0+ , QuickCheck >= 2.4 && < 3.0 , bytestring >= 0.9 && < 0.11- , conduit >= 1.2.8 && < 2.0+ , 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- , QuickCheck >= 2.4 && < 3.0 , 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 , zip+ if flag(dev)+ ghc-options: -O0 -Wall -Werror+ else+ ghc-options: -O2 -Wall default-language: Haskell2010 source-repository head