LibZip 0.0.2 → 0.1.0
raw patch · 17 files changed
+1922/−599 lines, 17 filesdep +bindings-DSLdep +filepathdep +mtldep −haskell98dep ~basesetup-changedbinary-added
Dependencies added: bindings-DSL, filepath, mtl, time
Dependencies removed: haskell98
Dependency ranges changed: base
Files
- C2HS.hs +0/−220
- Codec/Archive/LibZip.chs +0/−352
- Codec/Archive/LibZip.hs +659/−0
- Codec/Archive/LibZip/Errors.hs +42/−0
- Codec/Archive/LibZip/LegacyZeroZero.hsc +181/−0
- Codec/Archive/LibZip/LowLevel.hsc +240/−0
- Codec/Archive/LibZip/Types.hs +289/−0
- LICENSE +1/−1
- LibZip.cabal +32/−19
- Setup.lhs +3/−7
- Tests/Common.hs +20/−0
- Tests/LegacyTests.hs +42/−0
- Tests/MonadicTests.hs +250/−0
- Tests/test.zip binary
- examples/hzip.hs +108/−0
- examples/legacyUnzip.hs +38/−0
- runTests.hs +17/−0
− C2HS.hs
@@ -1,220 +0,0 @@--- C->Haskell Compiler: Marshalling library------ Copyright (c) [1999...2005] Manuel M T Chakravarty------ Redistribution and use in source and binary forms, with or without--- modification, are permitted provided that the following conditions are met:--- --- 1. Redistributions of source code must retain the above copyright notice,--- this list of conditions and the following disclaimer. --- 2. Redistributions in binary form must reproduce the above copyright--- notice, this list of conditions and the following disclaimer in the--- documentation and/or other materials provided with the distribution. --- 3. The name of the author may not be used to endorse or promote products--- derived from this software without specific prior written permission. ------ THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR--- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES--- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN--- NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED--- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR--- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF--- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING--- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS--- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.------- Description --------------------------------------------------------------------- Language: Haskell 98------ This module provides the marshaling routines for Haskell files produced by --- C->Haskell for binding to C library interfaces. It exports all of the--- low-level FFI (language-independent plus the C-specific parts) together--- with the C->HS-specific higher-level marshalling routines.-----module C2HS (-- -- * Re-export the language-independent component of the FFI - module Foreign,-- -- * Re-export the C language component of the FFI- module CForeign,-- -- * Composite marshalling functions- withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,- peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,-- -- * Conditional results using 'Maybe'- nothingIf, nothingIfNull,-- -- * Bit masks- combineBitMasks, containsBitMask, extractBitMasks,-- -- * Conversion between C and Haskell types- cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum-) where ---import Foreign- hiding (Word)- -- Should also hide the Foreign.Marshal.Pool exports in- -- compilers that export them-import CForeign--import Monad (when, liftM)----- Composite marshalling functions--- ----------------------------------- Strings with explicit length----withCStringLenIntConv s f = withCStringLen s $ \(p, n) -> f (p, cIntConv n)-peekCStringLenIntConv (s, n) = peekCStringLen (s, cIntConv n)---- Marshalling of numerals-----withIntConv :: (Storable b, Integral a, Integral b) - => a -> (Ptr b -> IO c) -> IO c-withIntConv = with . cIntConv--withFloatConv :: (Storable b, RealFloat a, RealFloat b) - => a -> (Ptr b -> IO c) -> IO c-withFloatConv = with . cFloatConv--peekIntConv :: (Storable a, Integral a, Integral b) - => Ptr a -> IO b-peekIntConv = liftM cIntConv . peek--peekFloatConv :: (Storable a, RealFloat a, RealFloat b) - => Ptr a -> IO b-peekFloatConv = liftM cFloatConv . peek---- Passing Booleans by reference-----withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b-withBool = with . fromBool--peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool-peekBool = liftM toBool . peek----- Passing enums by reference-----withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c-withEnum = with . cFromEnum--peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a-peekEnum = liftM cToEnum . peek----- Storing of 'Maybe' values--- ---------------------------instance Storable a => Storable (Maybe a) where- sizeOf _ = sizeOf (undefined :: Ptr ())- alignment _ = alignment (undefined :: Ptr ())-- peek p = do- ptr <- peek (castPtr p)- if ptr == nullPtr- then return Nothing- else liftM Just $ peek ptr-- poke p v = do- ptr <- case v of- Nothing -> return nullPtr- Just v' -> new v'- poke (castPtr p) ptr----- Conditional results using 'Maybe'--- ------------------------------------- Wrap the result into a 'Maybe' type.------ * the predicate determines when the result is considered to be non-existing,--- ie, it is represented by `Nothing'------ * the second argument allows to map a result wrapped into `Just' to some--- other domain----nothingIf :: (a -> Bool) -> (a -> b) -> a -> Maybe b-nothingIf p f x = if p x then Nothing else Just $ f x---- |Instance for special casing null pointers.----nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b-nothingIfNull = nothingIf (== nullPtr)----- Support for bit masks--- ------------------------- Given a list of enumeration values that represent bit masks, combine these--- masks using bitwise disjunction.----combineBitMasks :: (Enum a, Bits b) => [a] -> b-combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)---- Tests whether the given bit mask is contained in the given bit pattern--- (i.e., all bits set in the mask are also set in the pattern).----containsBitMask :: (Bits a, Enum b) => a -> b -> Bool-bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm- in- bm' .&. bits == bm'---- |Given a bit pattern, yield all bit masks that it contains.------ * This does *not* attempt to compute a minimal set of bit masks that when--- combined yield the bit pattern, instead all contained bit masks are--- produced.----extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]-extractBitMasks bits = - [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]----- Conversion routines--- ----------------------- |Integral conversion----cIntConv :: (Integral a, Integral b) => a -> b-cIntConv = fromIntegral---- |Floating conversion----cFloatConv :: (RealFloat a, RealFloat b) => a -> b-cFloatConv = realToFrac--- As this conversion by default goes via `Rational', it can be very slow...-{-# RULES - "cFloatConv/Float->Float" forall (x::Float). cFloatConv x = x;- "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x- #-}---- |Obtain C value from Haskell 'Bool'.----cFromBool :: Num a => Bool -> a-cFromBool = fromBool---- |Obtain Haskell 'Bool' from C value.----cToBool :: Num a => a -> Bool-cToBool = toBool---- |Convert a C enumeration to Haskell.----cToEnum :: (Integral i, Enum e) => i -> e-cToEnum = toEnum . cIntConv---- |Convert a Haskell enumeration to C.----cFromEnum :: (Enum e, Integral i) => e -> i-cFromEnum = cIntConv . fromEnum
− Codec/Archive/LibZip.chs
@@ -1,352 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DeriveDataTypeable #-}---- | Partial Haskell bindings to @libzip@ library.--- These bindings provide read-only access to zip archives.--- Produced with @c2hs@ for @libzip@ ver. 0.9.------ API is not stabilized yet, especially high-level part. If you use it, please--- let me know. Feedback and suggestions are welcome.-module Codec.Archive.LibZip- (-- * Types- Zip,ZipFile,OpenFlag(..),FileFlag(..),ZipError(..)- ,Word8- -- * High-level interface- -- These functions are intended to reduce boiler-plate. They acquire and- -- release relevant resources automatically (open and close archives, files).- ,withZip,getFiles,getFileSize- ,readZipFile,readZipFile',readZipFileHead,readZipFileHead'- -- * Low-level direct bindings to @libzip@ functions- -- These functions correspond to their C namesakes with @zip_@ prefix.- -- Please refer to @libzip@ documentation to learn about their semantics.- ,open,close,get_num_files,get_name- ,fopen,fclose,fread- -- * Utilities- ,catchZipError,isFile,isDir- ) where--import C2HS--import qualified Control.Exception as E-import qualified Data.ByteString as B-import Control.Applicative ((<$>))-import Data.Typeable--#include "zip.h"--{# context lib="zip" prefix="zip_" #}---- | Flags for 'withZip'.-{# enum define OpenFlag- { ZIP_CREATE as CreateFlag- , ZIP_EXCL as ExclFlag- , ZIP_CHECKCONS as CheckConsFlag- } deriving (Show,Eq) #}---- | Flags for 'getFiles', 'getFileSize', 'readZipFile', ...--- Please consult @libzip@ documentation about their use.-{# enum define FileFlag- { ZIP_FL_NOCASE as FileNOCASE- , ZIP_FL_NODIR as FileNODIR- , ZIP_FL_COMPRESSED as FileCOMPRESSED- , ZIP_FL_UNCHANGED as FileUNCHANGED- , ZIP_FL_RECOMPRESS as FileRECOMPRESS- } deriving (Show,Eq) #}---- | @libzip@ error codes.-{# enum define ZipError- { ZIP_ER_OK as ErrOK- , ZIP_ER_MULTIDISK as ErrMULTIDISK- , ZIP_ER_RENAME as ErrRENAME- , ZIP_ER_CLOSE as ErrCLOSE- , ZIP_ER_SEEK as ErrSEEK- , ZIP_ER_READ as ErrREAD- , ZIP_ER_WRITE as ErrWRITE- , ZIP_ER_CRC as ErrCRC- , ZIP_ER_ZIPCLOSED as ErrZIPCLOSED- , ZIP_ER_NOENT as ErrNOENT- , ZIP_ER_EXISTS as ErrEXISTS- , ZIP_ER_OPEN as ErrOPEN- , ZIP_ER_TMPOPEN as ErrTMPOPEN- , ZIP_ER_ZLIB as ErrZLIB- , ZIP_ER_MEMORY as ErrMEMORY- , ZIP_ER_CHANGED as ErrCHANGED- , ZIP_ER_COMPNOTSUPP as ErrCOMPNOTSUPP- , ZIP_ER_EOF as ErrEOF- , ZIP_ER_INVAL as ErrINVAL- , ZIP_ER_NOZIP as ErrNOZIP- , ZIP_ER_INTERNAL as ErrINTERNAL- , ZIP_ER_INCONS as ErrINCONS- , ZIP_ER_REMOVE as ErrREMOVE- , ZIP_ER_DELETED as ErrDELETED- } deriving (Eq,Typeable) #}--instance E.Exception ZipError--instance Show ZipError where- show ErrOK = "No error"- show ErrMULTIDISK = "Multi-disk zip archives not supported"- show ErrRENAME = "Renaming temporary file failed"- show ErrCLOSE = "Closing zip archive failed"- show ErrSEEK = "Seek error"- show ErrREAD = "Read error"- show ErrWRITE = "Write error"- show ErrCRC = "CRC error"- show ErrZIPCLOSED = "Containing zip archive was closed"- show ErrNOENT = "No such file"- show ErrEXISTS = "File already exists"- show ErrOPEN = "Can't open file"- show ErrTMPOPEN = "Failure to create temporary file"- show ErrZLIB = "Zlib error"- show ErrMEMORY = "Malloc failure"- show ErrCHANGED = "Entry has been changed"- show ErrCOMPNOTSUPP = "Compression method not supported"- show ErrEOF = "Premature EOF"- show ErrINVAL = "Invalid argument"- show ErrNOZIP = "Not a zip archive"- show ErrINTERNAL = "Internal error"- show ErrINCONS = "Zip archive inconsistent"- show ErrREMOVE = "Can't remove file"- show ErrDELETED = "Entry has been deleted"---- | Handler of the open zip file.-{# pointer *zip as Zip newtype #}--instance Show Zip where- show z@(Zip p)- | isOpen z = "Zip[open:" ++ (show p) ++ "]"- | otherwise = "Zip[closed]"--isOpen :: Zip -> Bool-isOpen (Zip p) = p /= nullPtr---- | Handler for an open file in the zip archive.-{# pointer *zip_file as ZipFile newtype #}--instance Show ZipFile where- show (ZipFile p)- | p /= nullPtr = "ZipFile[open:" ++ (show p) ++ "]"- | otherwise = "ZipFile[closed]"--#c-typedef struct zip_stat *zip_stat_t;-#endc--{--{# enum define CompMethod- { ZIP_CM_DEFAULT as CompDEFAULT- , ZIP_CM_STORE as CompSTORE- , ZIP_CM_SHRINK as CompSHRINK- , ZIP_CM_REDUCE_1 as CompREDUCE_1- , ZIP_CM_REDUCE_2 as CompREDUCE_2- , ZIP_CM_REDUCE_3 as CompREDUCE_3- , ZIP_CM_REDUCE_4 as CompREDUCE_4- , ZIP_CM_IMPLODE as CompIMPLODE- , ZIP_CM_DEFLATE as CompDEFLATE- , ZIP_CM_DEFLATE64 as CompDEFLATE64- , ZIP_CM_PKWARE_IMPLODE as CompPKWARE_IMPLODE- , ZIP_CM_BZIP2 as CompBZIP2- , ZIP_CM_LZMA as CompLZMA- , ZIP_CM_TERSE as CompTERSE- , ZIP_CM_LZ77 as CompLZ77- , ZIP_CM_WAVPACK as CompWAVPACK- , ZIP_CM_PPMD as CompPPMD- } deriving (Show,Eq) #}--{# enum define EncryptMethod- { ZIP_EM_NONE as EncryptNONE- , ZIP_EM_TRAD_PKWARE as EncryptTRAD_PKWARE- , ZIP_EM_UNKNOWN as EncryptUNKNOWN- } deriving (Show,Eq) #}--}---- struct zip *zip_open(const char *, int, int *);-{# fun open as open_- { `String'- , combineBitMasks `[OpenFlag]'- , alloca- `ZipError' peekError*- } -> `Zip' id #}- where peekError i = peek i >>= return . toEnum . cIntConv---- | Open zip archive specified by /path/ and return its handler on success.-open :: String -- ^ /path/ of the file to open- -> [OpenFlag] -- ^ open mode- -> IO Zip-open path flags = do- (z,e) <- open_ path flags- if isOpen z- then return z- else E.throwIO e---- int zip_close(struct zip *);-{# fun close as close_- { id `Zip'- } -> `Int' #}---- | Close zip archive.-close :: Zip -> IO ()-close z = do- r <- close_ z- if r == 0- then return ()- else E.throwIO ErrINTERNAL -- FIXME---- int zip_get_num_files(struct zip *);------ | Return the number of files in the archive.-{# fun get_num_files- { id `Zip'- } -> `Int' errorOnNegative* #}- where errorOnNegative i | i < 0 = E.throwIO ErrZIPCLOSED- errorOnNegative i = return $ cIntConv i---- const char *zip_get_name(struct zip *, int, int);------ | Get name of file by index.-{# fun get_name- { id `Zip'- , `Int'- , combineBitMasks `[FileFlag]'- } -> `String' errorOnNull* #}- where errorOnNull p | p /= nullPtr = peekCString p- errorOnNull _ | otherwise = E.throwIO ErrINVAL -- FIXME---- struct zip_file *zip_fopen(struct zip *, const char *, int);-{# fun zip_fopen as fopen_- { id `Zip'- , `String'- , combineBitMasks `[FileFlag]'- } -> `ZipFile' id #}---- | Open file in zip archive for reading.-fopen :: Zip -> String -> [FileFlag] -> IO ZipFile-fopen z fn flags = do- zf@(ZipFile ptr) <- fopen_ z fn flags- if ptr == nullPtr- then E.throwIO ErrNOENT -- FIXME- else return zf---- int zip_fclose(struct zip_file *);------ | Close file in zip archive.-{# fun zip_fclose as fclose- { id `ZipFile'- } -> `()' errorOrNothing* #}- where errorOrNothing 0 = return ()- errorOrNothing _ = E.throwIO ErrINVAL -- FIXME---- ssize_t zip_fread(struct zip_file *, void *, size_t);------ | Read from file in zip archive.-fread :: ZipFile -> Int -> IO [Word8]-fread zf count = do- allocaBuf $ \ptr -> do- rcount <- {#call zip_fread#} zf ptr (cIntConv count)- if rcount < 0- then E.throwIO ErrREAD- else peekBuf ptr >>= return . take (cIntConv rcount)- where- -- Nasty pointer casts to deal with void*- allocaBuf :: (Ptr () -> IO [Word8]) -> IO [Word8]- allocaBuf f =- let alloc = allocaArray count :: (Ptr Word8 -> IO [Word8]) -> IO [Word8]- castFun :: (Ptr () -> IO [a]) -> (Ptr a -> IO [a])- castFun fun = \ptrb -> let ptra = castPtr ptrb in fun ptra- in alloc $ castFun f- peekBuf :: Ptr () -> IO [Word8]- peekBuf p = peekArray count $ castPtr p---- High level Haskell wrappers---- | Open zip archive, do something, and close the archive.-withZip :: String -- ^ /path/ of the file to open- -> [OpenFlag] -- ^ open mode- -> (Zip -> IO a) -- ^ action to do on zip arhive- -> IO a-withZip filename flags action = do- z <- open filename flags- result <- action z- close z- return result---- | Get names of the files in archive.-getFiles :: Zip -> [FileFlag] -> IO [String]-getFiles z flags = do- n <- get_num_files z- mapM (\i -> get_name z i flags) [0..(n-1)]---- | Get size of the file in archive.-getFileSize :: Zip -- ^ zip archive- -> String -- ^ name of the file in the archive- -> [FileFlag] -- ^ file name mode- -> IO Int-getFileSize z name flags =- withCString name $ \name' ->- allocaBytes {# sizeof zip_stat_t #} $ \st -> do- {# call zip_stat_init #} st- ret <- {# call zip_stat #} z name' (combineBitMasks flags) st- if ret /= 0- then E.throwIO ErrINTERNAL -- FIXME- else fromIntegral <$> {# get zip_stat_t->size #} st---- | Read uncompressed file from the archive. Produce a strict ByteString.-readZipFile :: Zip -- ^ zip archive- -> String -- ^ name of the file in the archive- -> [FileFlag] -- ^ file name mode- -> IO B.ByteString-readZipFile z fname flags = return . B.pack =<< readZipFile' z fname flags---- | Read uncompressed file from the archive. Produce a list of 'Word8'.-readZipFile' :: Zip -- ^ zip archive- -> String -- ^ name of the file in the archive- -> [FileFlag] -- ^ file name mode- -> IO [Word8]-readZipFile' z fname flags = do- sz <- getFileSize z fname flags- readZipFileHead' z fname flags sz---- | Read beginning of the uncompressed file from the archive. Produce a list of 'Word8'.-readZipFileHead' :: Zip -- ^ zip archive- -> String -- ^ name of the file in the archive- -> [FileFlag] -- ^ file name mode- -> Int -- ^ how many bytes to read- -> IO [Word8]-readZipFileHead' z fname flags n = do- f <- fopen z fname flags- bytes <- fread f n- fclose f- return bytes---- | Read beginning of the uncompressed file from the archive. Produce a strict ByteString.-readZipFileHead :: Zip -- ^ zip archive- -> String -- ^ name of the file in the archive- -> [FileFlag] -- ^ file name mode- -> Int -- ^ how many bytes to read- -> IO B.ByteString-readZipFileHead z fname flags n = return . B.pack =<< readZipFileHead' z fname flags n---- Helpers---- | Wrapper to catch library errors.-catchZipError :: IO a -> (ZipError -> IO a) -> IO a-catchZipError f h = E.catchJust ifZipError f h- where- ifZipError :: (Typeable e, E.Exception e) => e -> Maybe e- ifZipError x | typeOf x == typeOf ErrOK = Just x- ifZipError _ | otherwise = Nothing---- | Return True if path is a file name, not a directory name (does not end with '/').-isFile :: String -> Bool-isFile filename = (lastMay filename /= Just '/')---- | Return True if path is a directory name (ends with '/').-isDir :: String -> Bool-isDir = not . isFile--lastMay :: [a] -> Maybe a-lastMay [] = Nothing-lastMay xs = Just $ last xs---- vim: set expandtab ts=2 sw=2 ai si:
+ Codec/Archive/LibZip.hs view
@@ -0,0 +1,659 @@+{- | Monadic interface to @libzip@.++Most of the operations on zip archive happen within 'Archive' monad+(see 'withArchive').+Partial reading of the files in the archive may be performed from+within 'Entry' monad (see 'fromFile').+Both 'Archive' and 'Entry' are monad transformers over 'IO', and allow+for IO with single and double 'lift'ing respectingly.++Note: LibZip does not handle text encodings. Even if its API accepts+'String's (e.g. in 'sourceBuffer'), character codes above 255 should+not be used. The user is responsible of proper encoding the text+data.++/Examples/++List files in the zip archive:++@+import System.Environment (getArgs)+import Codec.Archive.LibZip++main = do+ (zipfile:_) <- getArgs+ files <- withArchive [] zipfile $ fileNames []+ mapM_ putStrLn files+@++Create a zip archive and a add file to the archive:++@+import System.Environment (getArgs)+import Codec.Archive.LibZip++main = do+ (zipfile:_) <- getArgs+ withArchive [CreateFlag] zipfile $ do+ zs <- sourceBuffer \"Hello World!\"+ addFile \"hello.txt\" zs+@++Extract and print a file from the zip archive:++@+import System.Environment (getArgs)+import Codec.Archive.LibZip++main = do+ (zipfile:file:_) <- getArgs+ bytes <- withArchive [] zipfile $ fileContents [] file+ putStrLn bytes+@++See also an implementation of a simple zip archiver @hzip.hs@ in the+@examples/@ directory of the source distribution.++-}+module Codec.Archive.LibZip+ (+ -- * Types+ Archive+ , Entry+ , ZipStat(..)+ -- * Archive operations+ , withArchive, getZip+ , numFiles, fileName, nameLocate, fileNames+ , fileSize, fileSizeIx+ , fileStat, fileStatIx+ , deleteFile, deleteFileIx+ , renameFile, renameFileIx+ , addFile, addDirectory+ , replaceFile, replaceFileIx+ , sourceBuffer, sourceFile, sourceZip+ , PureSource(..), sourcePure+ , getComment, setComment, removeComment+ , getFileComment, getFileCommentIx+ , setFileComment, setFileCommentIx+ , removeFileComment, removeFileCommentIx+ , unchangeFile, unchangeFileIx+ , unchangeArchive, unchangeAll+ -- * File reading operations+ , fromFile, fromFileIx+ , readBytes, skipBytes, readContents+ , fileContents, fileContentsIx+ -- * Flags and options+ , OpenFlag(..)+ , FileFlag(..)+ , ZipCompMethod(..)+ , ZipEncryptionMethod(..)+ -- * Exception handling+ , ZipError(..)+ , catchZipError+ -- * Re-exports+ , lift+ ) where++import Codec.Archive.LibZip.LowLevel+import Codec.Archive.LibZip.Types+import Codec.Archive.LibZip.Errors++import Data.Time.Clock (UTCTime, getCurrentTime)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)+import Data.Word (Word8)+import Control.Monad.State.Strict+ (StateT(..), MonadState(..), MonadTrans(..), lift, liftM)+import Foreign.C.Error (Errno(..), eINVAL)+import Foreign.C.String (withCString, withCStringLen, peekCString)+import Foreign.C.Types (CInt, CSize)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Array (allocaArray, peekArray, withArrayLen, pokeArray)+import Foreign.Marshal.Utils (with)+import Foreign.Ptr (Ptr, nullPtr, castPtr)+import Foreign.Storable (Storable, peek, poke, pokeElemOff, sizeOf)+import qualified Control.Exception as E++--+-- Types+--++-- | Monadic computation with a zip archive. See 'withArchive'.+type Archive a = StateT Zip IO a++-- | Monadic computation to read from open archive entries.+-- See 'fromFile' and 'fromFileIx'.+type Entry a = StateT+ (ZipFile,Int,[FileFlag]) -- (file, position index, access flags)+ (StateT Zip IO) -- archive monad+ a++--+-- Archive operations+--++-- | Top-level wrapper for operations with an open+-- archive. 'withArchive' opens and closes the file+-- automatically. On error it throws 'ZipError'.+withArchive :: [OpenFlag] -- ^ Checks for consistency or existence.+ -> FilePath -- ^ Filename of the zip archive.+ -> Archive a -- ^ Action to do with the archive.+ -> IO a+withArchive flags path action =+ withCString path $ \path' ->+ alloca $ \errp ->+ c'zip_open path' (combine flags) errp >>= \z ->+ if z == nullPtr+ then peek errp >>= E.throwIO. errFromCInt+ else do+ r <- fst `liftM` runStateT action z+ e <- c'zip_close z+ if e /= 0+ then get_error z >>= E.throwIO+ else return r++-- | Get the number of entries in the archive.+numFiles :: Archive Int+numFiles = do+ z <- getZip+ lift $ fromIntegral `liftM` c'zip_get_num_files z++-- | Get name of an entry in the archive by its index.+fileName :: [FileFlag] -- ^ 'FileUNCHANGED' flag can be used.+ -> Int -- ^ Position index of a file in the archive.+ -> Archive FilePath -- ^ Name of the file in the archive.+fileName flags i = do+ z <- getZip+ lift $ do+ n <- c'zip_get_name z (fromIntegral i) (combine flags)+ doIf' (n /= nullPtr) z $ peekCString n++-- | Locate an entry (get its index) in the archive by its name.+nameLocate :: [FileFlag] -- ^ Filename lookup mode.+ -> FilePath -- ^ Name of the file in the archive.+ -> Archive (Maybe Int) -- ^ 'Just' position index if found.+nameLocate flags name = do+ z <- getZip+ lift $+ withCString name $ \name' -> do+ i <- fromIntegral `liftM` c'zip_name_locate z name' (combine flags)+ if i < 0+ then return Nothing+ else return (Just i)++-- | Get names of all entries (files and directories) in the archive.+fileNames :: [FileFlag] -- ^ 'FileUNCHANGED' flag is accepted.+ -> Archive [FilePath]+fileNames flags = do+ n <- numFiles+ mapM (fileName flags) [0..n-1]++-- | Get size of a file in the archive.+fileSize :: [FileFlag] -- ^ Filename lookup mode, 'FileUNCHANGED' can be used.+ -> FilePath -- ^ Name of the file in the archive.+ -> Archive Int -- ^ File size.+fileSize flags name = fileStat flags name >>= return . zs'size++-- | Get size of a file in the archive (by index).+fileSizeIx :: [FileFlag] -- ^ 'FileUNCHANGED' is accepted.+ -> Int -- ^ Position index of a file in the archive.+ -> Archive Int -- ^ File size.+fileSizeIx flags i = fileStatIx flags i >>= return . zs'size++-- | Get information about a file in the archive.+fileStat :: [FileFlag] -- ^ Filename lookup mode, 'FileUNCHANGED' can be used.+ -> FilePath -- ^ Name of the file in the archive.+ -> Archive ZipStat -- ^ Infomation about the file.+fileStat flags name = do+ z <- getZip+ lift $+ withCString name $ \name' ->+ alloca $ \stat -> do+ c'zip_stat_init stat+ r <- c'zip_stat z name' (combine flags) stat+ doIf' (r == 0) z $ toZipStat =<< peek stat++-- | Get information about a file in the archive (by index).+fileStatIx :: [FileFlag] -- ^ 'FileUNCHANGED' can be used.+ -> Int -- ^ Position index of a file in the archive.+ -> Archive ZipStat -- ^ Information about the file.+fileStatIx flags i = do+ z <- getZip+ lift $+ alloca $ \stat -> do+ r <- c'zip_stat_index z (fromIntegral i) (combine flags) stat+ doIf' (r == 0) z $ toZipStat =<< peek stat++-- | Delete file from the archive.+deleteFile :: [FileFlag] -- ^ Filename lookup mode.+ -> FilePath -- ^ Filename.+ -> Archive ()+deleteFile flags name = do+ mbi <- nameLocate flags name+ maybe (lift $ E.throwIO ErrNOENT) deleteFileIx mbi++-- | Delete file (referenced by position index) from the archive.+deleteFileIx :: Int -- ^ Position index of a file in the archive.+ -> Archive ()+deleteFileIx i = do+ z <- getZip+ r <- lift $ c'zip_delete z (fromIntegral i)+ if r == 0+ then return ()+ else lift $ get_error z >>= E.throwIO++-- | Rename file in the archive.+renameFile :: [FileFlag] -- ^ Filename lookup mode.+ -> FilePath -- ^ Old name.+ -> FilePath -- ^ New name.+ -> Archive ()+renameFile flags oldname newname = do+ mbi <- nameLocate flags oldname+ maybe (lift $ E.throwIO ErrNOENT) (\i -> renameFileIx i newname) mbi++-- | Rename file (referenced by position index) in the archive.+renameFileIx :: Int -- ^ Position index of a file in the archive.+ -> FilePath -- ^ New name.+ -> Archive ()+renameFileIx i newname = do+ z <- getZip+ r <- lift $ withCString newname $ c'zip_rename z (fromIntegral i)+ if r == 0+ then return ()+ else lift $ get_error z >>= E.throwIO++-- | Add a file to the archive.+addFile :: FilePath -- ^ Name of the file to create.+ -> ZipSource -- ^ Source where file data is obtained from.+ -> Archive Int -- ^ Position index of the new file.+addFile name src = do+ z <- getZip+ lift $ withCString name $ \name' -> do+ i <- c'zip_add z name' src+ if i < 0+ then c'zip_source_free src >> get_error z >>= E.throwIO+ else return $ fromIntegral i++-- | Add a directory to the archive.+addDirectory :: FilePath -- ^ Directory's name in the archive.+ -> Archive Int -- ^ Position index of the new directory entry.+addDirectory name = do+ z <- getZip+ r <- lift $ withCString name $ c'zip_add_dir z+ if r < 0+ then lift $ get_error z >>= E.throwIO+ else return (fromIntegral r)++-- | Replace a file in the archive.+replaceFile :: [FileFlag] -- ^ Filename lookup mode.+ -> FilePath -- ^ File to replace.+ -> ZipSource -- ^ Source where the new file data is obtained from.+ -> Archive ()+replaceFile flags name src = do+ mbi <- nameLocate flags name+ maybe (lift $ c'zip_source_free src >> E.throwIO ErrNOENT)+ (\i -> replaceFileIx i src >> return ()) mbi++-- | Replace a file in the archive (referenced by position index).+replaceFileIx :: Int -- ^ Position index of a file in the archive.+ -> ZipSource -- ^ Source where the new file data is obtained from+ -> Archive ()+replaceFileIx i src = do+ z <- getZip+ lift $ do+ r <- c'zip_replace z (fromIntegral i) src+ if r < 0+ then c'zip_source_free src >> get_error z >>= E.throwIO+ else return ()++-- | Create a data source. Note: input is converted to @[Word8]@ internally.+sourceBuffer :: (Enum a)+ => [a]+ -> Archive ZipSource+sourceBuffer src = do+ let ws = map (toEnum . fromEnum) src :: [Word8]+ z <- getZip+ lift $ withArrayLen ws $ \len buf -> do+ zs <- c'zip_source_buffer z (castPtr buf) (fromIntegral len) 0+ if zs == nullPtr+ then get_error z >>= E.throwIO+ else return zs++-- | Create a data source from a file.+sourceFile :: FilePath -- ^ File to open.+ -> Int -- ^ Offset from the beginning of the file.+ -> Int -- ^ The number of bytes to read. If @0@ or @-1@,+ -- the read till the end of file.+ -> Archive ZipSource+sourceFile name offset len = do+ z <- getZip+ lift $ withCString name $ \name' -> do+ zs <- c'zip_source_file z name' (fromIntegral offset) (fromIntegral len)+ if zs == nullPtr+ then get_error z >>= E.throwIO+ else return zs++-- | Create a data source from a file in the zip archive.+sourceZip :: [FileFlag] -- ^ 'FileUNCHANGED' and 'FileRECOMPRESS' can be used.+ -> Zip -- ^ Source archive.+ -> Int -- ^ Position index of a file in the source archive.+ -> Int -- ^ Offset from the beginning of the file.+ -> Int -- ^ The number of bytes to read. If @0@ or @-1@,+ -- then read till the end of file.+ -> Archive ZipSource+sourceZip flags srcz srcidx offset len = do+ z <- getZip+ lift $ do+ zs <- c'zip_source_zip z srcz (fromIntegral srcidx)+ (combine flags) (fromIntegral offset) (fromIntegral len)+ if zs == nullPtr+ then get_error z >>= E.throwIO+ else return zs++-- | Create a data source from a 'PureSource'.+-- Note: input of @[a]@ is converted to @[Word8]@ internally.+sourcePure :: (Enum a, Storable a, Storable st)+ => PureSource a st -> Archive ZipSource+sourcePure pureSrc = do+ z <- getZip+ lift $ do+ cb <- mk'zip_source_callback (runPureSource pureSrc)+ zs <- with (srcState pureSrc) $+ \pState -> c'zip_source_function z cb (castPtr pState)+ if zs == nullPtr+ then get_error z >>= E.throwIO+ else return zs++-- | Wrapper for a user-provided pure function to be used with 'sourcePure'.+-- Data size should be known in advance ('srcSize').+-- The function should support reading by chunks ('readSrc').+data (Enum a, Storable a, Storable st) => PureSource a st = PureSource {+ srcState :: st -- ^ Initial state of the source.+ , srcSize :: Int -- ^ Total size of the data.+ , srcMTime :: Maybe UTCTime -- ^ Modification time (current time if Nothing).+ , readSrc :: Int -> st -> Maybe (Int, [a], st) -- ^ Read a chunk of the data,+ -- return @Just@ the size of data read, the data themselves and+ -- the new state of the source, or @Nothing@ on error.+ }++runPureSource :: (Enum a, Storable a, Storable st)+ => PureSource a st+ -> (Ptr () -> Ptr () -> CSize -> C'zip_source_cmd -> IO CSize)+runPureSource src pState pData len cmd+ | cmd == c'ZIP_SOURCE_OPEN = return 0+ | cmd == c'ZIP_SOURCE_READ = do+ state <- peek (castPtr pState :: Ptr st)+ case readSrc (src { srcState = state }) (fromIntegral len) state of+ Just (len',bs,state') -> do+ pokeArray (castPtr pData :: Ptr Word8) (map (toEnum.fromEnum) bs)+ poke (castPtr pState) state'+ return (fromIntegral len')+ Nothing -> return (-1)+ | cmd == c'ZIP_SOURCE_CLOSE = return 0+ | cmd == c'ZIP_SOURCE_STAT = do+ t <- maybe getCurrentTime return (srcMTime src)+ let pt = fromInteger . round . utcTimeToPOSIXSeconds $ t+ let pStat = castPtr pData+ c'zip_stat_init pStat+ stat <- peek pStat+ let stat' = stat { c'zip_stat'mtime = pt+ , c'zip_stat'size = fromIntegral $ srcSize src }+ poke pStat stat'+ return $ fromIntegral (sizeOf stat')+ | cmd == c'ZIP_SOURCE_ERROR = do+ let pErrs = castPtr pData :: Ptr CInt+ poke pErrs (fromIntegral . fromEnum $ ErrINVAL)+ let (Errno esys) = eINVAL+ pokeElemOff pErrs 1 esys+ return $ fromIntegral (2 * sizeOf esys)+ | cmd == c'ZIP_SOURCE_FREE = return 0+ | otherwise = return (-1)+ +-- | Get zip archive comment.+getComment :: [FileFlag] -- ^ 'FileUNCHANGED' can be used.+ -> Archive (Maybe String)+getComment flags = do+ z <- getZip+ (c,n) <- lift $ alloca $ \lenp -> do+ c <- c'zip_get_archive_comment z lenp (combine flags)+ n <- peek lenp+ return (c,n)+ if c == nullPtr+ then return Nothing+ else lift $ peekCString c >>= return . Just . take (fromIntegral n)++-- | Set zip archive comment.+setComment :: String -- ^ Comment message.+ -> Archive ()+setComment msg = do+ z <- getZip+ r <- lift $ withCStringLen msg $ \(msg',i') ->+ c'zip_set_archive_comment z msg' (fromIntegral i')+ if r < 0+ then lift $ get_error z >>= E.throwIO+ else return ()++-- | Remove zip archive comment.+removeComment :: Archive ()+removeComment = do+ z <- getZip+ r <- lift $ c'zip_set_archive_comment z nullPtr 0+ if r < 0+ then lift $ get_error z >>= E.throwIO+ else return ()++-- | Get comment for a file in the archive.+getFileComment :: [FileFlag] -- ^ Filename lookup mode.+ -> FilePath -- ^ Filename+ -> Archive (Maybe String)+getFileComment flags name = do+ mbi <- nameLocate flags name+ maybe (lift $ E.throwIO ErrNOENT) (getFileCommentIx flags) mbi++-- | Get comment for a file in the archive (referenced by position index).+getFileCommentIx :: [FileFlag] -- ^ FileUNCHANGED can be used.+ -> Int -- ^ Position index of the file.+ -> Archive (Maybe String)+getFileCommentIx flags i = do+ z <- getZip+ (c,n) <- lift $ alloca $ \lenp -> do+ c <- c'zip_get_file_comment z (fromIntegral i) lenp (combine flags)+ n <- peek lenp+ return (c,n)+ if c == nullPtr+ then return Nothing+ else lift $ peekCString c >>= return . Just . take (fromIntegral n)++-- | Set comment for a file in the archive.+setFileComment :: [FileFlag] -- ^ Name lookup mode.+ -> FilePath -- ^ Filename.+ -> String -- ^ New file comment.+ -> Archive ()+setFileComment flags path comment = do+ mbi <- nameLocate flags path+ maybe (lift $ E.throwIO ErrNOENT) (flip setFileCommentIx comment) mbi++-- | Set comment for a file in the archive (referenced by position index).+setFileCommentIx :: Int -- ^ Position index of a file in the archive.+ -> String -- ^ New file comment. + -> Archive ()+setFileCommentIx i comment = do+ z <- getZip+ r <- lift $ withCStringLen comment $ \(msg,len) ->+ c'zip_set_file_comment z (fromIntegral i) msg (fromIntegral len)+ if r < 0+ then lift $ get_error z >>= E.throwIO+ else return ()++-- | Remove comment for a file in the archive.+removeFileComment :: [FileFlag] -- ^ Filename lookup mode.+ -> FilePath -- ^ Filename.+ -> Archive ()+removeFileComment flags path = do+ mbi <- nameLocate flags path+ maybe (lift $ E.throwIO ErrNOENT) removeFileCommentIx mbi++-- | Remove comment for a file in the archive (referenced by position index).+removeFileCommentIx :: Int -- ^ Position index of a file in the archive.+ -> Archive ()+removeFileCommentIx i = do+ z <- getZip+ r <- lift $ c'zip_set_file_comment z (fromIntegral i) nullPtr 0+ if r < 0+ then lift $ get_error z >>= E.throwIO+ else return ()++-- | Undo changes to a file in the archive.+unchangeFile :: [FileFlag] -- ^ Filename lookup mode.+ -> FilePath -- ^ Filename.+ -> Archive ()+unchangeFile flags name = do+ mbi <- nameLocate flags name+ maybe (lift $ E.throw ErrNOENT) unchangeFileIx mbi++-- | Undo changes to a file in the archive (referenced by position index).+unchangeFileIx :: Int -- ^ Position index of a file in the archive.+ -> Archive ()+unchangeFileIx i = do+ z <- getZip+ lift $ do+ r <- c'zip_unchange z (fromIntegral i)+ if r < 0+ then get_error z >>= E.throwIO+ else return ()++-- | Undo global changes to zip archive (revert changes to the archive+-- comment and global flags).+unchangeArchive :: Archive ()+unchangeArchive = do+ z <- getZip+ lift $ do+ r <- c'zip_unchange_archive z+ if r < 0+ then get_error z >>= E.throwIO+ else return ()++-- | Undo all changes in a zip archive.+unchangeAll :: Archive ()+unchangeAll = do+ z <- getZip+ lift $ do+ r <- c'zip_unchange_all z+ if r < 0+ then get_error z >>= E.throwIO+ else return ()++--+-- File reading operations+--++-- | Wrapper for operations with a file in the archive. 'fromFile' is normally+-- called from within an 'Archive' action (see also 'withArchive').+-- 'fromFile' can be replaced with 'fileContents' to read an entire file at+-- once.+fromFile :: [FileFlag] -- ^ Filename lookup mode,+ -- 'FileCOMPRESSED' and 'FileUNCHANGED' can be used.+ -> FilePath -- ^ Name of the file in the arhive.+ -> Entry a -- ^ Action with the file.+ -> Archive a+fromFile flags name action = do+ z <- getZip+ nameLocate flags name >>= maybe (lift $ get_error z >>= E.throwIO) runAction+ where+ runAction i = do+ z <- getZip+ zf <- lift $ withCString name $ \n -> c'zip_fopen z n (combine flags)+ if zf == nullPtr+ then lift $ get_error z >>= E.throwIO+ else do+ r <- fst `liftM` runStateT action (zf,i,flags)+ e <- lift $ c'zip_fclose zf+ if e /= 0+ then lift $ E.throwIO $ (toEnum . fromIntegral $ e :: ZipError)+ else return r++-- | Wrapper for operations with a file in the archive. File is referenced+-- by index (position). 'fromFileIx' is normally called from within+-- an 'Archive' action (see also 'withArchive'). 'fromFileIx' can be replaced+-- with 'fileContentsIx' to read an entire file at once.+fromFileIx :: [FileFlag] -- ^ 'FileCOMPRESSED' and 'FileUNCHANGED' can be used.+ -> Int -- ^ Position index of a file in the archive.+ -> Entry a -- ^ Action with the file.+ -> Archive a+fromFileIx flags i action = do+ z <- getZip+ zf <- lift $ c'zip_fopen_index z (fromIntegral i) (combine flags)+ if zf == nullPtr+ then lift $ get_error z >>= E.throwIO+ else do+ r <- fst `liftM` runStateT action (zf,i,flags)+ e <- lift $ c'zip_fclose zf+ if e /= 0+ then lift $ E.throwIO $ (toEnum . fromIntegral $ e :: ZipError)+ else return r++-- | Read at most @n@ bytes from the file.+readBytes ::+ (Enum a)+ => Int -- ^ The number of bytes to read.+ -> Entry [a] -- ^ Bytes read.+readBytes n = do+ (zf,_,_) <- get+ lift . lift $ allocaArray n $ \buf -> do+ nread <- c'zip_fread zf (castPtr buf) (fromIntegral n)+ if nread < 0+ then+ get_file_error zf >>= E.throwIO+ else do+ bs <- peekArray (fromIntegral nread) buf :: IO [Word8]+ return . map (toEnum . fromEnum) $ bs++-- | Skip @n@ bytes from the open file. Note: this is not faster than reading.+skipBytes :: Int -> Entry ()+skipBytes n = (readBytes n :: Entry [Word8]) >> return ()++-- | Read entire file contents.+readContents ::+ (Enum a)+ => Entry [a] -- ^ Contents of the file.+readContents = do+ (_,i,flags) <- get+ sz <- lift $ fileSizeIx flags i+ readBytes sz++-- | Read entire file. Shortcut for 'readContents' from within 'Archive' monad.+fileContents :: (Enum a)+ => [FileFlag]+ -> FilePath+ -> Archive [a]+fileContents flags name = fromFile flags name readContents++-- | Read entire file (referenced by position index). Shortcut for+-- 'readContents' from within 'Archive' monad.+fileContentsIx :: (Enum a)+ => [FileFlag]+ -> Int+ -> Archive [a]+fileContentsIx flags i = fromFileIx flags i readContents++--+-- Helpers+--++-- | Get archive handler. Throw 'ErrINVAL' if the archive is closed.+getZip :: Archive Zip+getZip = do+ z <- get+ if z == nullPtr+ then lift $ E.throwIO ErrINVAL+ else return z++-- | Get and throw a 'ZipError' if condition fails. Otherwise work normally.+doIf :: Bool -> Zip -> (Zip -> IO a) -> IO a+doIf cnd z action =+ if cnd+ then action z+ else get_error z >>= E.throwIO++-- | Get and throw a 'ZipError' if condition fails. See also 'doIf'.+doIf' :: Bool -> Zip -> (IO a) -> IO a+doIf' cnd z action = doIf cnd z (const action)
+ Codec/Archive/LibZip/Errors.hs view
@@ -0,0 +1,42 @@+-- | Error handling functions.+module Codec.Archive.LibZip.Errors+ ( errFromCInt+ , get_error+ , get_file_error+ , catchZipError+ ) where++import Data.Typeable (Typeable, typeOf)+import Foreign.C.Types+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (nullPtr)+import Foreign.Storable (peek)+import qualified Control.Exception as E++import Codec.Archive.LibZip.LowLevel+import Codec.Archive.LibZip.Types++errFromCInt :: CInt -> ZipError+errFromCInt = toEnum . fromEnum++get_error :: Zip -> IO ZipError+get_error z | z == nullPtr = E.throwIO ErrINVAL+get_error z = alloca $ \zep -> do+ c'zip_error_get z zep nullPtr+ peek zep >>= return . errFromCInt++get_file_error :: ZipFile -> IO ZipError+get_file_error zf+ | zf == nullPtr = E.throwIO ErrINVAL+ | otherwise = alloca $ \zep -> do+ c'zip_file_error_get zf zep nullPtr+ peek zep >>= return . errFromCInt+ +-- | Wrapper to catch library errors.+catchZipError :: IO a -> (ZipError -> IO a) -> IO a+catchZipError f h = E.catchJust ifZipError f h+ where+ ifZipError :: (Typeable e, E.Exception e) => e -> Maybe e+ ifZipError x | typeOf x == typeOf ErrOK = Just x+ ifZipError _ | otherwise = Nothing+
+ Codec/Archive/LibZip/LegacyZeroZero.hsc view
@@ -0,0 +1,181 @@+-- | This module is a backwards compatible replacement for @Codec.Archive.LibZip@ module of LibZip 0.0.x. This API is deprecated, please don't use it in new code.+module Codec.Archive.LibZip.LegacyZeroZero (+ -- * Types+ Zip,ZipFile,OpenFlag(..),FileFlag(..),ZipError(..)+ ,Word8+ -- * High-level interface+ ,withZip,getFiles,getFileSize+ ,readZipFile,readZipFile'+ ,readZipFileHead,readZipFileHead'+ -- * Low-level bindings+ ,open,close,get_num_files,get_name+ ,fopen,fopen_index,fclose,fread+ -- * Utilities+ ,catchZipError,isFile,isDir+ ) where++import Control.Monad (liftM)+import Data.Word (Word8)+import Foreign.C.String (withCString,peekCString)+import Foreign.Marshal.Alloc (alloca)+import Foreign.Marshal.Array (allocaArray, peekArray)+import Foreign.Ptr (Ptr, nullPtr, castPtr)+import Foreign.Storable (peek)+import qualified Control.Exception as E+import qualified Data.ByteString as B++import Codec.Archive.LibZip.LowLevel+import Codec.Archive.LibZip.Types+import Codec.Archive.LibZip.Errors++-- | Open zip archive specified by /path/ and return its handler on success.+open :: String -- ^ /path/ of the file to open+ -> [OpenFlag] -- ^ open mode+ -> IO Zip -- ^ handler of the open zip archive+open path flags =+ withCString path $ \path' ->+ alloca $ \errp -> do+ z <- c'zip_open path' (combine flags) errp+ if z /= nullPtr+ then return z+ else peek errp >>= E.throwIO . errFromCInt++-- | Close zip archive.+close :: Zip -> IO ()+close z | z == nullPtr = E.throwIO ErrINVAL+close z = do+ r <- c'zip_close z+ if r == 0+ then return ()+ else E.throwIO =<< get_error z++-- | Return the number of files in the archive.+get_num_files :: Zip -> IO Int+get_num_files z | z == nullPtr = E.throwIO ErrINVAL+get_num_files z = fromIntegral `liftM` c'zip_get_num_files z++-- | Get name of file by index.+get_name :: Zip -> Int -> [FileFlag] -> IO String+get_name z _ _ | z == nullPtr = E.throwIO ErrINVAL+get_name z i flags = do+ n <- c'zip_get_name z (fromIntegral i) (combine flags)+ if n /= nullPtr+ then peekCString n+ else E.throwIO =<< get_error z++-- | Open file in zip archive for reading.+fopen :: Zip -> String -> [FileFlag] -> IO ZipFile+fopen z _ _ | z == nullPtr = E.throwIO ErrINVAL+fopen z fn flags = withCString fn $ \fn' ->+ returnNotNull z =<< c'zip_fopen z fn' (combine flags)++-- | Open n-th file in zip archive for reading.+fopen_index :: Zip -> Int -> [FileFlag] -> IO ZipFile+fopen_index z _ _ | z == nullPtr = E.throwIO ErrINVAL+fopen_index z i flags =+ returnNotNull z =<< c'zip_fopen_index z (fromIntegral i) (combine flags)++-- | Close file in zip archive.+fclose :: ZipFile -> IO ()+fclose zf =+ errorOrNothing =<< c'zip_fclose zf+ where errorOrNothing 0 = return ()+ errorOrNothing e = E.throwIO (errFromCInt e)++-- | Read from file in zip archive.+fread :: ZipFile -> Int -> IO [Word8]+fread zf count =+ allocaArray count $ \buf -> do+ rcount <- c'zip_fread zf (castPtr buf) (fromIntegral count)+ if rcount < 0+ then E.throwIO ErrREAD+ else peekArray (fromIntegral rcount) buf++-- High level Haskell wrappers++-- | Open zip archive, do something, and close the archive.+withZip :: String -- ^ /path/ of the file to open+ -> [OpenFlag] -- ^ open mode+ -> (Zip -> IO a) -- ^ action to do on zip arhive+ -> IO a+withZip filename flags action = do+ z <- open filename flags+ result <- action z+ close z+ return result++-- | Get names of the files in archive.+getFiles :: Zip -> [FileFlag] -> IO [String]+getFiles z flags = do+ n <- get_num_files z+ mapM (\i -> get_name z i flags) [0..(n-1)]++-- | Get size of the file in archive.+getFileSize :: Zip -- ^ zip archive+ -> String -- ^ name of the file in the archive+ -> [FileFlag] -- ^ file name mode+ -> IO Int+getFileSize z name flags =+ withCString name $ \name' ->+ alloca $ \stat -> do+ ret <- c'zip_stat z name' (combine flags) stat+ if ret /= 0+ then E.throwIO =<< get_error z+ else return . fromIntegral . c'zip_stat'size =<< peek stat++-- | Read uncompressed file from the archive. Produce a strict ByteString.+readZipFile :: Zip -- ^ zip archive+ -> String -- ^ name of the file in the archive+ -> [FileFlag] -- ^ file name mode+ -> IO B.ByteString+readZipFile z fname flags = return . B.pack =<< readZipFile' z fname flags++-- | Read uncompressed file from the archive. Produce a list of 'Word8'.+readZipFile' :: Zip -- ^ zip archive+ -> String -- ^ name of the file in the archive+ -> [FileFlag] -- ^ file name mode+ -> IO [Word8]+readZipFile' z fname flags = do+ sz <- getFileSize z fname flags+ readZipFileHead' z fname flags sz++-- | Read beginning of the uncompressed file from the archive. Produce a list of 'Word8'.+readZipFileHead' :: Zip -- ^ zip archive+ -> String -- ^ name of the file in the archive+ -> [FileFlag] -- ^ file name mode+ -> Int -- ^ how many bytes to read+ -> IO [Word8]+readZipFileHead' z fname flags n = do+ f <- fopen z fname flags+ bytes <- fread f n+ fclose f+ return bytes++-- | Read beginning of the uncompressed file from the archive. Produce a strict ByteString.+readZipFileHead :: Zip -- ^ zip archive+ -> String -- ^ name of the file in the archive+ -> [FileFlag] -- ^ file name mode+ -> Int -- ^ how many bytes to read+ -> IO B.ByteString+readZipFileHead z fname flags n = return . B.pack =<< readZipFileHead' z fname flags n+++-- | Return True if path is a file name, not a directory name (does not end with '/').+isFile :: String -> Bool+isFile filename = (lastMay filename /= Just '/')++-- | Return True if path is a directory name (ends with '/').+isDir :: String -> Bool+isDir = not . isFile++lastMay :: [a] -> Maybe a+lastMay [] = Nothing+lastMay xs = Just $ last xs++-- Return the second argument or throw the last libzip error.+returnNotNull :: Zip -> Ptr a -> IO (Ptr a)+returnNotNull z _ | z == nullPtr = E.throwIO ErrINVAL+returnNotNull z ptr =+ if ptr /= nullPtr+ then return ptr+ else E.throwIO =<< get_error z
+ Codec/Archive/LibZip/LowLevel.hsc view
@@ -0,0 +1,240 @@+#include <bindings.dsl.h>+#include <zip.h>++-- | This module provides automatic low-level bindings to @libzip@ library.+-- See also:+--+-- * @libzip@ documention: <http://nih.at/libzip/libzip.html> and @zip.h@+--+-- * @bindings-DSL@ documentation:+-- <http://bitbucket.org/mauricio/bindings-dsl/wiki/Home>++module Codec.Archive.LibZip.LowLevel where+#strict_import++#opaque_t zip+#opaque_t zip_file+#opaque_t zip_source++-- flags for zip_open++#num ZIP_CREATE+#num ZIP_EXCL+#num ZIP_CHECKCONS++-- flags for zip_name_locate, zip_fopen, zip_stat, ...++#num ZIP_FL_NOCASE+#num ZIP_FL_NODIR+#num ZIP_FL_COMPRESSED+#num ZIP_FL_UNCHANGED+#num ZIP_FL_RECOMPRESS++-- archive global flags flags++#num ZIP_AFL_TORRENT++-- libzip error codes++#num ZIP_ER_OK+#num ZIP_ER_MULTIDISK+#num ZIP_ER_RENAME+#num ZIP_ER_CLOSE+#num ZIP_ER_SEEK+#num ZIP_ER_READ+#num ZIP_ER_WRITE+#num ZIP_ER_CRC+#num ZIP_ER_ZIPCLOSED+#num ZIP_ER_NOENT+#num ZIP_ER_EXISTS+#num ZIP_ER_OPEN+#num ZIP_ER_TMPOPEN+#num ZIP_ER_ZLIB+#num ZIP_ER_MEMORY+#num ZIP_ER_CHANGED+#num ZIP_ER_COMPNOTSUPP+#num ZIP_ER_EOF+#num ZIP_ER_INVAL+#num ZIP_ER_NOZIP+#num ZIP_ER_INTERNAL+#num ZIP_ER_INCONS+#num ZIP_ER_REMOVE+#num ZIP_ER_DELETED++-- type of system error value++#num ZIP_ET_NONE+#num ZIP_ET_SYS+#num ZIP_ET_ZLIB++-- compression methods++#num ZIP_CM_DEFAULT+#num ZIP_CM_STORE+#num ZIP_CM_SHRINK+#num ZIP_CM_REDUCE_1+#num ZIP_CM_REDUCE_2+#num ZIP_CM_REDUCE_3+#num ZIP_CM_REDUCE_4+#num ZIP_CM_IMPLODE+#num ZIP_CM_DEFLATE+#num ZIP_CM_DEFLATE64+#num ZIP_CM_PKWARE_IMPLODE+#num ZIP_CM_BZIP2+#num ZIP_CM_LZMA+#num ZIP_CM_TERSE+#num ZIP_CM_LZ77+#num ZIP_CM_WAVPACK+#num ZIP_CM_PPMD++-- encryption methods++#num ZIP_EM_NONE+#num ZIP_EM_TRAD_PKWARE+#num ZIP_EM_UNKNOWN++#integral_t enum zip_source_cmd+#num ZIP_SOURCE_OPEN+#num ZIP_SOURCE_READ+#num ZIP_SOURCE_CLOSE+#num ZIP_SOURCE_STAT+#num ZIP_SOURCE_ERROR+#num ZIP_SOURCE_FREE++-- typedef ssize_t (*zip_source_callback)(void *state, void *data,+-- size_t len, enum zip_source_cmd cmd);+#callback zip_source_callback , Ptr () -> Ptr () -> CSize -> <zip_source_cmd> -> IO CSize++#opaque_t time_t++#starttype struct zip_stat+#field name, Ptr CChar+#field index, CInt+#field crc, CUInt+#field mtime, CTime+#field size, CSize+#field comp_size, CSize+#field comp_method, CUShort+#field encryption_method, CUShort+#stoptype++-- int zip_add(struct zip *, const char *, struct zip_source *);+#ccall zip_add , Ptr <zip> -> CString -> Ptr <zip_source> -> IO CInt++-- int zip_add_dir(struct zip *, const char *);+#ccall zip_add_dir , Ptr <zip> -> CString -> IO CInt++-- int zip_close(struct zip *);+#ccall zip_close , Ptr <zip> -> IO CInt++-- int zip_delete(struct zip *, int);+#ccall zip_delete , Ptr <zip> -> CInt -> IO CInt++-- void zip_error_clear(struct zip *);+#ccall zip_error_clear , Ptr <zip> -> IO ()++-- void zip_error_get(struct zip *, int *, int *);+#ccall zip_error_get , Ptr <zip> -> Ptr CInt -> Ptr CInt -> IO ()++-- int zip_error_get_sys_type(int);+#ccall zip_error_get_sys_type , CInt -> IO CInt++-- int zip_error_to_str(char *, size_t, int, int);+#ccall zip_error_to_str , Ptr Char -> CSize -> CInt -> CInt -> IO CInt++-- int zip_fclose(struct zip_file *);+#ccall zip_fclose , Ptr <zip_file> -> IO CInt++-- void zip_file_error_clear(struct zip_file *);+#ccall zip_file_error_clear , Ptr <zip_file> -> IO ()++-- void zip_file_error_get(struct zip_file *, int *, int *);+#ccall zip_file_error_get , Ptr <zip_file> -> Ptr CInt -> Ptr CInt -> IO ()++-- const char *zip_file_strerror(struct zip_file *);+#ccall zip_file_strerror , Ptr <zip_file> -> IO CString++-- struct zip_file *zip_fopen(struct zip *, const char *, int);+#ccall zip_fopen , Ptr <zip> -> CString -> CInt -> IO (Ptr <zip_file>)++-- struct zip_file *zip_fopen_index(struct zip *, int, int);+#ccall zip_fopen_index , Ptr <zip> -> CInt -> CInt -> IO (Ptr <zip_file>)++-- ssize_t zip_fread(struct zip_file *, void *, size_t);+#ccall zip_fread , Ptr <zip_file> -> Ptr () -> CSize -> IO CSize++-- const char *zip_get_archive_comment(struct zip *, int *, int);+#ccall zip_get_archive_comment , Ptr <zip> -> Ptr CInt -> CInt -> IO CString++-- int zip_get_archive_flag(struct zip *, int, int);+#ccall zip_get_archive_flag , Ptr <zip> -> CInt -> CInt -> IO CInt++-- const char *zip_get_file_comment(struct zip *, int, int *, int);+#ccall zip_get_file_comment , Ptr <zip> -> CInt -> Ptr CInt -> CInt -> IO CString++-- const char *zip_get_name(struct zip *, int, int);+#ccall zip_get_name , Ptr <zip> -> CInt -> CInt -> IO CString++-- int zip_get_num_files(struct zip *);+#ccall zip_get_num_files , Ptr <zip> -> IO CInt++-- int zip_name_locate(struct zip *, const char *, int);+#ccall zip_name_locate , Ptr <zip> -> CString -> CInt -> IO CInt++-- struct zip *zip_open(const char *, int, int *);+#ccall zip_open , CString -> CInt -> Ptr CInt -> IO (Ptr <zip>)++-- int zip_rename(struct zip *, int, const char *);+#ccall zip_rename , Ptr <zip> -> CInt -> CString -> IO CInt++-- int zip_replace(struct zip *, int, struct zip_source *);+#ccall zip_replace , Ptr <zip> -> CInt -> Ptr <zip_source> -> IO CInt++-- int zip_set_archive_comment(struct zip *, const char *, int);+#ccall zip_set_archive_comment , Ptr <zip> -> CString -> CInt -> IO CInt++-- int zip_set_archive_flag(struct zip *, int, int);+#ccall zip_set_archive_flag , Ptr <zip> -> CInt -> CInt -> IO CInt++-- int zip_set_file_comment(struct zip *, int, const char *, int);+#ccall zip_set_file_comment , Ptr <zip> -> CInt -> CString -> CInt -> IO CInt++-- struct zip_source *zip_source_buffer(struct zip *, const void *, off_t, int);+#ccall zip_source_buffer , Ptr <zip> -> Ptr () -> CSize -> CInt -> IO (Ptr <zip_source>)++-- struct zip_source *zip_source_file(struct zip *, const char *, off_t, off_t);+#ccall zip_source_file , Ptr <zip> -> CString -> CSize -> CSize -> IO (Ptr <zip_source>)++-- struct zip_source *zip_source_filep(struct zip *, FILE *, off_t, off_t);+#ccall zip_source_filep , Ptr <zip> -> Ptr CFile -> CSize -> CSize -> IO (Ptr <zip_source>)++-- void zip_source_free(struct zip_source *);+#ccall zip_source_free , Ptr <zip_source> -> IO ()++-- struct zip_source *zip_source_function(struct zip *, zip_source_callback, void *);+#ccall zip_source_function , Ptr <zip> -> <zip_source_callback> -> Ptr () -> IO (Ptr <zip_source>)++-- struct zip_source *zip_source_zip(struct zip *, struct zip *, int, int, off_t, off_t);+#ccall zip_source_zip , Ptr <zip> -> Ptr <zip> -> CInt -> CInt -> CSize -> CSize -> IO (Ptr <zip_source>)++-- int zip_stat(struct zip *, const char *, int, struct zip_stat *);+#ccall zip_stat , Ptr <zip> -> CString -> CInt -> Ptr <zip_stat> -> IO CInt++-- int zip_stat_index(struct zip *, int, int, struct zip_stat *);+#ccall zip_stat_index , Ptr <zip> -> CInt -> CInt -> Ptr <zip_stat> -> IO CInt++-- void zip_stat_init(struct zip_stat *);+#ccall zip_stat_init , Ptr <zip_stat> -> IO ()++-- const char *zip_strerror(struct zip *);+#ccall zip_strerror , Ptr <zip> -> IO CString++-- int zip_unchange(struct zip *, int);+#ccall zip_unchange , Ptr <zip> -> CInt -> IO CInt++-- int zip_unchange_all(struct zip *);+#ccall zip_unchange_all , Ptr <zip> -> IO CInt++-- int zip_unchange_archive(struct zip *);+#ccall zip_unchange_archive , Ptr <zip> -> IO CInt+
+ Codec/Archive/LibZip/Types.hs view
@@ -0,0 +1,289 @@+{-# LANGUAGE DeriveDataTypeable#-}++module Codec.Archive.LibZip.Types+ ( Zip+ , ZipFile+ , ZipSource+ , ZipStat(..)+ , toZipStat+ , OpenFlag(..)+ , FileFlag(..)+ , ZipError(..)+ , ZipCompMethod(..)+ , ZipEncryptionMethod(..)+ , combine+ ) where+ +import Data.Bits ((.|.))+import Data.Time (UTCTime)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import Data.Typeable (Typeable)+import Data.Word (Word)+import Foreign.C.String (peekCString)+import Foreign.C.Types ()+import Foreign.Ptr (Ptr, nullPtr)+import qualified Control.Exception as E++import Codec.Archive.LibZip.LowLevel++-- | Handler of the open zip file.+type Zip = Ptr C'zip++-- | Handler of an open file in the zip archive.+type ZipFile = Ptr C'zip_file++-- | Handler of data source for new files in the zip archive.+type ZipSource = Ptr C'zip_source++-- | File statistics expressed in native Haskell types.+data ZipStat = ZipStat {+ zs'name :: String+ , zs'index :: Int+ , zs'crc :: Word+ , zs'mtime :: UTCTime+ , zs'size :: Int+ , zs'comp_size :: Int+ , zs'comp_method :: ZipCompMethod+ , zs'encryption_method :: ZipEncryptionMethod+ } deriving (Show, Eq)++-- | Convert marshalled stat record.+toZipStat :: C'zip_stat -> IO ZipStat+toZipStat s = do+ let np = c'zip_stat'name s+ name <- if (np /= nullPtr) then peekCString np else return ""+ let idx = fromIntegral $ c'zip_stat'index s+ let crc = fromIntegral $ c'zip_stat'crc s+ let mtime = posixSecondsToUTCTime . realToFrac $ c'zip_stat'mtime s+ let size = fromIntegral $ c'zip_stat'size s+ let comp_size = fromIntegral $ c'zip_stat'comp_size s+ let comp_meth = toEnum . fromIntegral $ c'zip_stat'comp_method s+ let enc_meth = toEnum . fromIntegral $ c'zip_stat'encryption_method s+ return $ ZipStat name idx crc mtime size comp_size comp_meth enc_meth+ ++-- | Flags for opening an archive.+data OpenFlag+ = CreateFlag -- ^ Create an archive if it does not exist.+ | ExclFlag -- ^ Error if the archive already exists.+ | CheckConsFlag -- ^ Check archive's consistency and error on failure.+ deriving (Show,Eq)++instance Enum OpenFlag where+ fromEnum CheckConsFlag = c'ZIP_CHECKCONS+ fromEnum CreateFlag = c'ZIP_CREATE+ fromEnum ExclFlag = c'ZIP_EXCL+ toEnum x | x == c'ZIP_CHECKCONS = CheckConsFlag+ toEnum x | x == c'ZIP_CREATE = CreateFlag+ toEnum x | x == c'ZIP_EXCL = ExclFlag+ toEnum _ = undefined++-- | Flags for accessing files in the archive.+-- Please consult @libzip@ documentation about their use.+data FileFlag+ = FileNOCASE -- ^ Ignore case on name lookup.+ | FileNODIR -- ^ Ignore directory component.+ | FileCOMPRESSED -- ^ Read the compressed data.+ | FileUNCHANGED -- ^ Read the original data, ignore changes.+ | FileRECOMPRESS -- ^ Force recompression of data.+ deriving (Show,Eq)++instance Enum FileFlag where+ fromEnum FileCOMPRESSED = c'ZIP_FL_COMPRESSED+ fromEnum FileNOCASE = c'ZIP_FL_NOCASE+ fromEnum FileNODIR = c'ZIP_FL_NODIR+ fromEnum FileRECOMPRESS = c'ZIP_FL_RECOMPRESS+ fromEnum FileUNCHANGED = c'ZIP_FL_UNCHANGED+ toEnum x | x == c'ZIP_FL_COMPRESSED = FileCOMPRESSED+ toEnum x | x == c'ZIP_FL_NOCASE = FileNOCASE+ toEnum x | x == c'ZIP_FL_NODIR = FileNODIR+ toEnum x | x == c'ZIP_FL_RECOMPRESS = FileRECOMPRESS+ toEnum x | x == c'ZIP_FL_UNCHANGED = FileUNCHANGED+ toEnum _ = undefined++-- | @libzip@ error codes.+data ZipError+ = ErrOK -- ^ No error.+ | ErrMULTIDISK -- ^ Multi-disk zip archives not supported.+ | ErrRENAME -- ^ Renaming temporary file failed.+ | ErrCLOSE -- ^ Closing zip archive failed.+ | ErrSEEK -- ^ Seek error.+ | ErrREAD -- ^ Read error.+ | ErrWRITE -- ^ Write error.+ | ErrCRC -- ^ CRC error.+ | ErrZIPCLOSED -- ^ Containing zip archive was closed.+ | ErrNOENT -- ^ No such file.+ | ErrEXISTS -- ^ File already exists.+ | ErrOPEN -- ^ Can't open file.+ | ErrTMPOPEN -- ^ Failure to create temporary file.+ | ErrZLIB -- ^ Zlib error.+ | ErrMEMORY -- ^ Malloc error.+ | ErrCHANGED -- ^ Entry has been changed.+ | ErrCOMPNOTSUPP -- ^ Compression method not supported.+ | ErrEOF -- ^ Premature EOF.+ | ErrINVAL -- ^ Invalid argument.+ | ErrNOZIP -- ^ Not a zip archive.+ | ErrINTERNAL -- ^ Internal error.+ | ErrINCONS -- ^ Zip archive inconsistent.+ | ErrREMOVE -- ^ Can't remove file.+ | ErrDELETED -- ^ Entry has been deleted.+ deriving (Eq, Typeable)++instance Enum ZipError where+ fromEnum ErrCHANGED = c'ZIP_ER_CHANGED+ fromEnum ErrCLOSE = c'ZIP_ER_CLOSE+ fromEnum ErrCOMPNOTSUPP = c'ZIP_ER_COMPNOTSUPP+ fromEnum ErrCRC = c'ZIP_ER_CRC+ fromEnum ErrDELETED = c'ZIP_ER_DELETED+ fromEnum ErrEOF = c'ZIP_ER_EOF+ fromEnum ErrEXISTS = c'ZIP_ER_EXISTS+ fromEnum ErrINCONS = c'ZIP_ER_INCONS+ fromEnum ErrINTERNAL = c'ZIP_ER_INTERNAL+ fromEnum ErrINVAL = c'ZIP_ER_INVAL+ fromEnum ErrMEMORY = c'ZIP_ER_MEMORY+ fromEnum ErrMULTIDISK = c'ZIP_ER_MULTIDISK+ fromEnum ErrNOENT = c'ZIP_ER_NOENT+ fromEnum ErrNOZIP = c'ZIP_ER_NOZIP+ fromEnum ErrOK = c'ZIP_ER_OK+ fromEnum ErrOPEN = c'ZIP_ER_OPEN+ fromEnum ErrREAD = c'ZIP_ER_READ+ fromEnum ErrREMOVE = c'ZIP_ER_REMOVE+ fromEnum ErrRENAME = c'ZIP_ER_RENAME+ fromEnum ErrSEEK = c'ZIP_ER_SEEK+ fromEnum ErrTMPOPEN = c'ZIP_ER_TMPOPEN+ fromEnum ErrWRITE = c'ZIP_ER_WRITE+ fromEnum ErrZIPCLOSED = c'ZIP_ER_ZIPCLOSED+ fromEnum ErrZLIB = c'ZIP_ER_ZLIB+ toEnum x | x == c'ZIP_ER_CHANGED = ErrCHANGED+ toEnum x | x == c'ZIP_ER_CLOSE = ErrCLOSE+ toEnum x | x == c'ZIP_ER_COMPNOTSUPP = ErrCOMPNOTSUPP+ toEnum x | x == c'ZIP_ER_CRC = ErrCRC+ toEnum x | x == c'ZIP_ER_DELETED = ErrDELETED+ toEnum x | x == c'ZIP_ER_EOF = ErrEOF+ toEnum x | x == c'ZIP_ER_EXISTS = ErrEXISTS+ toEnum x | x == c'ZIP_ER_INCONS = ErrINCONS+ toEnum x | x == c'ZIP_ER_INTERNAL = ErrINTERNAL+ toEnum x | x == c'ZIP_ER_INVAL = ErrINVAL+ toEnum x | x == c'ZIP_ER_MEMORY = ErrMEMORY+ toEnum x | x == c'ZIP_ER_MULTIDISK = ErrMULTIDISK+ toEnum x | x == c'ZIP_ER_NOENT = ErrNOENT+ toEnum x | x == c'ZIP_ER_NOZIP = ErrNOZIP+ toEnum x | x == c'ZIP_ER_OK = ErrOK+ toEnum x | x == c'ZIP_ER_OPEN = ErrOPEN+ toEnum x | x == c'ZIP_ER_READ = ErrREAD+ toEnum x | x == c'ZIP_ER_REMOVE = ErrREMOVE+ toEnum x | x == c'ZIP_ER_RENAME = ErrRENAME+ toEnum x | x == c'ZIP_ER_SEEK = ErrSEEK+ toEnum x | x == c'ZIP_ER_TMPOPEN = ErrTMPOPEN+ toEnum x | x == c'ZIP_ER_WRITE = ErrWRITE+ toEnum x | x == c'ZIP_ER_ZIPCLOSED = ErrZIPCLOSED+ toEnum x | x == c'ZIP_ER_ZLIB = ErrZLIB+ toEnum _ = undefined++instance E.Exception ZipError++instance Show ZipError where+ show ErrOK = "No error"+ show ErrMULTIDISK = "Multi-disk zip archives not supported"+ show ErrRENAME = "Renaming temporary file failed"+ show ErrCLOSE = "Closing zip archive failed"+ show ErrSEEK = "Seek error"+ show ErrREAD = "Read error"+ show ErrWRITE = "Write error"+ show ErrCRC = "CRC error"+ show ErrZIPCLOSED = "Containing zip archive was closed"+ show ErrNOENT = "No such file"+ show ErrEXISTS = "File already exists"+ show ErrOPEN = "Can't open file"+ show ErrTMPOPEN = "Failure to create temporary file"+ show ErrZLIB = "Zlib error"+ show ErrMEMORY = "Malloc failure"+ show ErrCHANGED = "Entry has been changed"+ show ErrCOMPNOTSUPP = "Compression method not supported"+ show ErrEOF = "Premature EOF"+ show ErrINVAL = "Invalid argument"+ show ErrNOZIP = "Not a zip archive"+ show ErrINTERNAL = "Internal error"+ show ErrINCONS = "Zip archive inconsistent"+ show ErrREMOVE = "Can't remove file"+ show ErrDELETED = "Entry has been deleted"++-- | Compression methods.+data ZipCompMethod+ = CompDEFAULT -- ^ Better of deflate or store.+ | CompSTORE -- ^ Stored (uncompressed).+ | CompSHRINK -- ^ Shrunk.+ | CompREDUCE_1 -- ^ Reduced with factor 1+ | CompREDUCE_2 -- ^ Reduced with factor 2+ | CompREDUCE_3 -- ^ Reduced with factor 3+ | CompREDUCE_4 -- ^ Reduced with factor 4+ | CompIMPLODE -- ^ Imploded.+ | CompDEFLATE -- ^ Deflated.+ | CompDEFLATE64 -- ^ Deflate64.+ | CompPKWARE_IMPLODE -- ^ PKWARE imploding.+ | CompBZIP2 -- ^ Compressed using BZIP2 algorithm.+ | CompLZMA -- ^ LZMA (EFS)+ | CompTERSE -- ^ Compressed using IBM TERSE (new).+ | CompLZ77 -- ^ IBM LZ77 z Architecture (PFS).+ | CompWAVPACK -- ^ WavPack compressed data.+ | CompPPMD -- ^ PPMd version I, Rev 1.+ deriving (Show, Eq)++instance Enum ZipCompMethod where+ fromEnum CompDEFAULT = c'ZIP_CM_DEFAULT+ fromEnum CompSTORE = c'ZIP_CM_STORE+ fromEnum CompSHRINK = c'ZIP_CM_SHRINK+ fromEnum CompREDUCE_1 = c'ZIP_CM_REDUCE_1+ fromEnum CompREDUCE_2 = c'ZIP_CM_REDUCE_2+ fromEnum CompREDUCE_3 = c'ZIP_CM_REDUCE_3+ fromEnum CompREDUCE_4 = c'ZIP_CM_REDUCE_4+ fromEnum CompIMPLODE = c'ZIP_CM_IMPLODE+ fromEnum CompDEFLATE = c'ZIP_CM_DEFLATE+ fromEnum CompDEFLATE64 = c'ZIP_CM_DEFLATE64+ fromEnum CompPKWARE_IMPLODE = c'ZIP_CM_PKWARE_IMPLODE+ fromEnum CompBZIP2 = c'ZIP_CM_BZIP2+ fromEnum CompLZMA = c'ZIP_CM_LZMA+ fromEnum CompTERSE = c'ZIP_CM_TERSE+ fromEnum CompLZ77 = c'ZIP_CM_LZ77+ fromEnum CompWAVPACK = c'ZIP_CM_WAVPACK+ fromEnum CompPPMD = c'ZIP_CM_PPMD+ toEnum x | x == c'ZIP_CM_DEFAULT = CompDEFAULT+ toEnum x | x == c'ZIP_CM_STORE = CompSTORE+ toEnum x | x == c'ZIP_CM_SHRINK = CompSHRINK+ toEnum x | x == c'ZIP_CM_REDUCE_1 = CompREDUCE_1+ toEnum x | x == c'ZIP_CM_REDUCE_2 = CompREDUCE_2+ toEnum x | x == c'ZIP_CM_REDUCE_3 = CompREDUCE_3+ toEnum x | x == c'ZIP_CM_REDUCE_4 = CompREDUCE_4+ toEnum x | x == c'ZIP_CM_IMPLODE = CompIMPLODE+ toEnum x | x == c'ZIP_CM_DEFLATE = CompDEFLATE+ toEnum x | x == c'ZIP_CM_DEFLATE64 = CompDEFLATE64+ toEnum x | x == c'ZIP_CM_PKWARE_IMPLODE = CompPKWARE_IMPLODE+ toEnum x | x == c'ZIP_CM_BZIP2 = CompBZIP2+ toEnum x | x == c'ZIP_CM_LZMA = CompLZMA+ toEnum x | x == c'ZIP_CM_TERSE = CompTERSE+ toEnum x | x == c'ZIP_CM_LZ77 = CompLZ77+ toEnum x | x == c'ZIP_CM_WAVPACK = CompWAVPACK+ toEnum x | x == c'ZIP_CM_PPMD = CompPPMD+ toEnum _ = undefined++-- | Encryption methods.+data ZipEncryptionMethod+ = EncryptNONE -- ^ Not encrypted.+ | EncryptTRAD_PKWARE -- ^ Traditional PKWARE encryption.+ | EncryptUNKNOWN -- ^ Unknown algorithm.+ deriving (Show,Eq)++instance Enum ZipEncryptionMethod where+ fromEnum EncryptNONE = c'ZIP_EM_NONE+ fromEnum EncryptTRAD_PKWARE = c'ZIP_EM_TRAD_PKWARE+ fromEnum EncryptUNKNOWN = c'ZIP_EM_UNKNOWN+ toEnum x | x == c'ZIP_EM_NONE = EncryptNONE+ toEnum x | x == c'ZIP_EM_TRAD_PKWARE = EncryptTRAD_PKWARE+ toEnum x | x == c'ZIP_EM_UNKNOWN = EncryptUNKNOWN+ toEnum _ = undefined++-- | ++combine :: (Enum a, Num b) => [a] -> b+combine fs = fromIntegral . foldr (.|.) 0 $ map fromEnum fs+
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2009, Sergey Astanin+Copyright (c) 2009, 2010, Sergey Astanin All rights reserved. Redistribution and use in source and binary forms, with or without
LibZip.cabal view
@@ -1,5 +1,5 @@ Name: LibZip-Version: 0.0.2+Version: 0.1.0 License: BSD3 License-File: LICENSE Author: Sergey Astanin@@ -8,27 +8,40 @@ Bug-reports: http://bitbucket.org/jetxee/hs-libzip/issues/ Category: Codec, Foreign-Synopsis: Partial bindings to libzip to read zip archives.+Synopsis: Bindings to libzip, a library for manipulating zip archives. Description:- This package provides basic read-only access to zip-archives.- It is produced with @c2hs@ for @libzip@ ver. 0.9.-Exposed-modules: Codec.Archive.LibZip-Other-modules: C2HS+ libzip is a C library for reading, creating, and modifying zip archives.+ This package allows to use it from Haskell code. Build-Type: Simple Cabal-Version: >= 1.2.3-Extra-Tmp-Files:- Codec/Archive/LibZip.hs- , Codec/Archive/LibZip.chs.h-Build-Tools: c2hs-Build-Depends: base >= 4.0 && < 4.2- , bytestring- , haskell98-GHC-Options: -Wall-Extensions: ForeignFunctionInterface- , FlexibleContexts- , DeriveDataTypeable- , CPP+Tested-With: GHC == 6.12.1 -Tested-with: GHC == 6.10.4+Extra-Source-Files:+ examples/legacyUnzip.hs, examples/hzip.hs+ , runTests.hs, Tests/Common.hs, Tests/LegacyTests.hs+ , Tests/MonadicTests.hs, Tests/test.zip++Library+ Extensions:+ ForeignFunctionInterface+ Exposed-Modules:+ Codec.Archive.LibZip+ Codec.Archive.LibZip.LowLevel+ Codec.Archive.LibZip.Types+ Codec.Archive.LibZip.LegacyZeroZero+ Other-Modules:+ Codec.Archive.LibZip.Errors+ Build-Depends:+ base >= 4.0 && < 4.3+ , bindings-DSL >= 1.0 && < 1.1+ , bytestring+ , filepath+ , time+ , mtl+ PkgConfig-Depends:+ libzip >= 0.9+ GHC-Options:+ -Wall+
Setup.lhs view
@@ -5,17 +5,13 @@ > import Distribution.PackageDescription (emptyHookedBuildInfo) > > main = defaultMainWithHooks simpleUserHooks-> { preBuild = generateC2HSdoths-> , runTests = runUnitTests+> { runTests = runUnitTests > } >-> generateC2HSdoths _ _ =-> system "c2hs -l" >>=-> onExit "Cannot copy C2HS.hs library module in." emptyHookedBuildInfo > > runUnitTests _ _ _ _ =-> system "cd tests && runhaskell -lzip Tests.hs" >>=-> onExit "Some tests did not pass." ()+> system "runhaskell -lzip runTests.hs" >>=+> onExit "\nSome tests did not pass." () > > onExit :: String -> a -> ExitCode -> IO a > onExit errmsg okvalue r =
+ Tests/Common.hs view
@@ -0,0 +1,20 @@+module Tests.Common+ ( testzip, testfiles, lastfile, lastfilesize+ , world_txt+ , toUpper, toLower, map2+ ) where++import Data.Char (toUpper, toLower)++testzip = "Tests/test.zip"+testfiles = [ "hello/", "hello/world.txt" ]+lastfile = last testfiles+lastfilesize = 71 :: Int++world_txt = "And God saw everything that he had made,\+ \ and behold, it was very good.\n"++-- map odd positions with f, even positions with g+map2 :: (a -> b) -> (a -> b) -> [a] -> [b]+map2 f g [] = []+map2 f g (x:xs) = (f x):map2 g f xs
+ Tests/LegacyTests.hs view
@@ -0,0 +1,42 @@+module Tests.LegacyTests+ ( legacyTests+ ) where++import Codec.Archive.LibZip.LegacyZeroZero++import Tests.Common++import qualified Data.ByteString as B+import Test.HUnit++legacyTests = TestList+ [ "read list of files" ~: do+ files <- withZip testzip [] $ \z -> getFiles z [] :: IO [String]+ files @?= testfiles+ , "read file size" ~: do+ sz <- withZip testzip [] $ \z -> getFileSize z lastfile []+ sz @?= lastfilesize+ , "case-insensitive file names" ~: do+ sz <- withZip testzip [] $ \z ->+ getFileSize z (map2 toUpper toLower $ lastfile) [FileNOCASE]+ sz @?= lastfilesize+ , "open error if exists (with ExclFlag)" ~: do+ err <- catchZipError+ (withZip testzip [ExclFlag] $ \_ -> return ErrOK)+ (return . id)+ err @?= ErrEXISTS+ , "read file" ~: do+ txt <- withZip testzip [] $ \z -> readZipFile z lastfile []+ txt @?= toByteString world_txt+ , "open file by index" ~: do+ txt <- withZip testzip [] $ \z -> do+ f <- fopen_index z 1 [] -- index 0 is of the parent dir+ bytes <- fread f (length world_txt)+ return $ B.pack bytes+ txt @?= toByteString world_txt+ ]+++toByteString :: String -> B.ByteString+toByteString s = B.pack $ map (fromIntegral . fromEnum) s+
+ Tests/MonadicTests.hs view
@@ -0,0 +1,250 @@+{-# LANGUAGE FlexibleInstances #-}+module Tests.MonadicTests where++import Codec.Archive.LibZip+import Tests.Common++import Data.Int (Int64)+import Foreign.Storable+import Foreign.Ptr (Ptr, castPtr)++import System.Directory (doesFileExist, getTemporaryDirectory, removeFile)+import System.FilePath ((</>))+import Test.HUnit+import qualified Control.Exception as E++monadicTests = TestList+ [ "read list of files" ~: do+ files <- withArchive [] testzip $ fileNames []+ files @?= testfiles+ , "read file size" ~: do+ sz <- withArchive [] testzip $ fileSize [] lastfile+ sz @?= lastfilesize+ , "case-insensitive file names" ~: do+ sz <- withArchive [] testzip $+ fileSize [FileNOCASE] (map2 toUpper toLower $ lastfile)+ sz @?= lastfilesize+ , "open error if exists (with ExclFlag)" ~: do+ err <- catchZipError+ (withArchive [ExclFlag] testzip $ lift $ E.throwIO ErrOK)+ (return . id)+ err @?= ErrEXISTS+ , "open error if archive does not exists" ~: do+ err <- catchZipError+ (withArchive [] "notexists.zip" $ return ErrOK)+ (return . id)+ err @?= ErrOPEN+ , "read file" ~: do+ txt <- withArchive [] testzip $ fileContents [] lastfile+ txt @?= world_txt+ , "read file by index" ~: do+ txt <- withArchive [] testzip $ fileContentsIx [] (length testfiles - 1)+ txt @?= world_txt+ , "skipBytes/readBytes" ~: do+ txt <- withArchive [] testzip $+ fromFile [] lastfile $ do+ skipBytes 13+ readBytes 10+ txt @?= (take 10 . drop 13 $ world_txt)+ , "create an archive/use sourceBuffer" ~: do+ tmpzip <- getTmpFileName "test_LibZip_sourceBuffer.zip"+ i <- withArchive [CreateFlag] tmpzip $ do+ addDirectory "hello"+ addFile "hello/world.txt" =<< sourceBuffer world_txt+ tmpzip `doesExistAnd` \f -> do+ txt <- withArchive [] f $ fileContents [] "hello/world.txt"+ removeFile f+ (txt, i) @?= (world_txt, 1)+ , "create an archive/use sourceFile" ~: do+ tmpzip <- getTmpFileName "test_LibZip_sourceFile.zip"+ tmpsrc <- getTmpFileName "test_LibZip_sourceFile.txt"+ writeFile tmpsrc world_txt+ withArchive [CreateFlag] tmpzip $+ addFile "world.txt" =<< sourceFile tmpsrc 0 0+ tmpzip `doesExistAnd` \f -> do+ txt <- withArchive [] f $ fileContents [] "world.txt"+ removeFile tmpzip+ removeFile tmpsrc+ txt @?= world_txt+ , "create an archive/use sourceZip" ~: do+ tmpzip <- getTmpFileName "test_LibZip_sourceZip.zip"+ withArchive [] testzip $ do+ zsrc <- getZip+ lift $ withArchive [CreateFlag] tmpzip $+ addFile "world.txt" =<< sourceZip [] zsrc 1 0 0+ tmpzip `doesExistAnd` \f -> do+ txt <- withArchive [] f $ fileContents [] "world.txt"+ removeFile tmpzip+ txt @?= world_txt+ , "create an archive/use sourcePure" ~: do+ tmpzip <- getTmpFileName "test_LibZip_sourcePure.zip"+ let src = PureSource+ { srcState = (0, length world_txt) -- needs a Storable instance+ , srcSize = length world_txt+ , srcMTime = Nothing+ , readSrc = \len (pos,lft) ->+ let n = min len lft+ buf = take n . drop pos $ world_txt+ in Just (n, buf, (pos+n,lft-n))+ }+ withArchive [CreateFlag] tmpzip $ do+ addFile "world.txt" =<< sourcePure src+ tmpzip `doesExistAnd` \f -> do+ txt <- withArchive [] f $ fileContents [] "world.txt"+ removeFile tmpzip+ txt @?= world_txt+ , "delete a file" ~: do+ let orig = [("one", "one"), ("two", "two")]+ let final = init orig+ tmpzip <- getTmpFileName "test_LibZip_delete.zip"+ mkArchive tmpzip orig+ fs_orig <- withArchive [] tmpzip $ fileNames []+ withArchive [] tmpzip $ deleteFile [] "two"+ fs_final <- withArchive [] tmpzip $ fileNames []+ removeFile tmpzip+ (fs_orig, fs_final) @?= (map fst orig, map fst final)+ , "attempt to delete a non-existing file" ~: do+ tmpzip <- getTmpFileName "test_LibZip_delete_ne.zip"+ mkArchive tmpzip [("world.txt", world_txt)]+ r1 <- catchZipError+ (withArchive [] tmpzip $+ deleteFile [] "doesnotexist" >> return ErrOK)+ (return . id)+ r2 <- catchZipError+ (withArchive [] tmpzip $+ deleteFileIx 100 >> return ErrOK)+ (return . id)+ removeFile tmpzip+ (r1, r2) @?= (ErrNOENT, ErrINVAL)+ , "rename a file" ~: do+ tmpzip <- getTmpFileName "test_LibZip_rename.zip"+ mkArchive tmpzip [("world.txt", world_txt)]+ fs <- withArchive [] tmpzip $ do+ renameFile [] "world.txt" "hello.txt"+ fileNames []+ removeFile tmpzip+ fs @?= ["hello.txt"]+ , "attempt to rename a non-existing file" ~: do+ tmpzip <- getTmpFileName "test_LibZip_rename_ne.zip"+ mkArchive tmpzip [("world.txt", world_txt)]+ r <- catchZipError+ (withArchive [] tmpzip $ do+ renameFile [] "doesnotexist" "hello.txt"+ return ErrOK)+ (return . id)+ removeFile tmpzip+ r @?= ErrNOENT+ , "attempt to rename to an empty name" ~: do+ tmpzip <- getTmpFileName "test_LibZip_rename_inval.zip"+ mkArchive tmpzip [("world.txt", world_txt)]+ r <- catchZipError+ (withArchive [] tmpzip $ do+ renameFile [] "world.txt" ""+ return ErrOK)+ (return . id)+ removeFile tmpzip+ r @?= ErrINVAL+ , "replace a file" ~: do+ tmpzip <- getTmpFileName "test_LibZip_replace.zip"+ mkArchive tmpzip [("hello/",""), ("hello/world.txt", "old contents")]+ withArchive [] tmpzip $+ replaceFile [] "hello/world.txt" =<< sourceBuffer world_txt+ txt <- withArchive [] tmpzip $ fileContents [] "hello/world.txt"+ txt @?= world_txt+ , "set/get/remove archive comment" ~: do+ c1 <- withArchive [] testzip $ getComment []+ tmpzip <- getTmpFileName "test_LibZip_comment.zip"+ mkArchive tmpzip [("hello/",""), ("hello/world.txt", world_txt)]+ c2 <- withArchive [] tmpzip $ getComment []+ let com = "this is a test"+ withArchive [] tmpzip $ setComment com+ c2_added <- withArchive [] tmpzip $ getComment []+ withArchive [] tmpzip $ removeComment+ c2_removed <- withArchive [] tmpzip $ getComment []+ removeFile tmpzip+ (c1, c2, c2_added, c2_removed) @?= (Nothing, Nothing, Just com, Nothing)+ , "set/get/remove file comment" ~: do+ tmpzip <- getTmpFileName "test_LibZip_file_comment.zip"+ let world_path = "hello/world.txt"+ let world_comm = "this is a test"+ mkArchive tmpzip [("hello/",undefined), (world_path,world_txt)]+ let get_comm = withArchive [] tmpzip $ getFileComment [] world_path+ c_off <- get_comm+ withArchive [] tmpzip $ setFileComment [] world_path world_comm+ c_on <- get_comm+ withArchive [] tmpzip $ removeFileComment [] world_path+ c_off' <- get_comm+ removeFile tmpzip+ (c_off, c_on, c_off') @?= (Nothing, Just world_comm, Nothing)+ , "unchange file" ~: do+ tmpzip <- getTmpFileName "test_LibZip_unchange_file.zip"+ mkArchive tmpzip [("world.txt",world_txt)]+ c <- withArchive [] tmpzip $ do+ setFileComment [] "world.txt" "a comment to undo"+ unchangeFile [] "world.txt"+ getFileComment [] "world.txt"+ removeFile tmpzip+ c @?= Nothing+ , "unchange archive" ~: do+ tmpzip <- getTmpFileName "test_LibZip_unchange.zip"+ mkArchive tmpzip [("world.txt",world_txt)]+ c <- withArchive [] tmpzip $ do+ setComment "a comment to undo"+ unchangeArchive+ getComment []+ removeFile tmpzip+ c @?= Nothing+ , "unchange all" ~: do+ tmpzip <- getTmpFileName "test_LibZip_unchange_all.zip"+ mkArchive tmpzip [("world.txt",world_txt)]+ c <- withArchive [] tmpzip $ do+ setComment "a comment to undo"+ setFileComment [] "world.txt" "a file comment to undo"+ unchangeAll+ c1 <- getComment []+ c2 <- getFileComment [] "world.txt"+ return (c1,c2)+ removeFile tmpzip+ c @?= (Nothing,Nothing)++ ]++getTmpFileName basename = do+ tmpdir <- getTemporaryDirectory+ let tmpfile = tmpdir </> basename+ doesFileExist tmpfile >>= \b ->+ if b+ then removeFile tmpfile >> return tmpfile+ else return tmpfile++doesExistAnd filepath assertion = do+ exists <- doesFileExist filepath+ if exists+ then assertion filepath+ else False @? ( "File " ++ filepath ++ " does not exist." )++-- for sourcePure, requires FlexibleInstances+instance Storable (Int,Int) where+ sizeOf _ = 2 * sizeOf (0::Int)+ alignment _ = alignment (0::Int)+ peek ptr = do+ let ptr' = castPtr ptr :: Ptr Int+ a <- peekElemOff ptr' 0+ b <- peekElemOff ptr' 1+ return (a, b)+ poke ptr (a,b) = do+ let ptr' = castPtr ptr :: Ptr Int+ pokeElemOff ptr' 0 $ a+ pokeElemOff ptr' 1 $ b++mkArchive :: (Enum a) => FilePath -> [(FilePath, [a])] -> IO ()+mkArchive zipname contents =+ withArchive [CreateFlag] zipname $+ mapM_ (\(f,d) ->+ if last f == '/'+ then addDirectory f+ else addFile f =<< sourceBuffer d+ ) contents+ ++
+ Tests/test.zip view
binary file changed (absent → 283 bytes)
+ examples/hzip.hs view
@@ -0,0 +1,108 @@+-- A utility to list, add or extract files in a zip archive.+--+-- This is an example of using LibZip library.+--+-- (c) Sergey Astanin 2010+-- License: BSD3+--+import Codec.Archive.LibZip++import Control.Monad (liftM, when)+import Data.List (intercalate)+import System.Directory (createDirectoryIfMissing, doesDirectoryExist, getCurrentDirectory, getDirectoryContents, makeRelativeToCurrentDirectory)+import System.Environment (getArgs)+import System.FilePath (joinPath, splitDirectories, takeDirectory)+import System.IO (stderr, hPutStr, hPutStrLn)++usage :: String+usage = unlines+ [ "Usage: hzip [l|a|x] archive.zip [files]"+ , " l list files in the archives"+ , " a add/update files or directories in the archive recursively"+ , " x extract files from the archive to the current direcotory"+ ]++main :: IO ()+main = do+ args <- getArgs+ case args of+ ("l":archive:_) -> list archive+ ("a":archive:files) -> mapM mkRel files >>= add archive+ ("x":archive:files) -> getCurrentDirectory >>= \d -> extract d archive files+ _ -> hPutStr stderr usage+ where+ mkRel = makeRelativeToCurrentDirectory++list :: FilePath -> IO ()+list archive = do+ stats <- withArchive [] archive $ do+ n <- numFiles+ mapM (fileStatIx []) [0..(n-1)]+ mapM_ printEntry stats+ where+ printEntry e =+ let sz = padLeft 8 . show $ zs'size e+ mt = take 16 . show $ zs'mtime e+ nm = zs'name e+ in putStrLn $ intercalate " " [ sz, mt, nm ]+ padLeft n s = let m = max 0 (n - length s) in replicate m ' ' ++ s++add :: FilePath -> [FilePath] -> IO ()+add archive paths = mapM_ (addEntry archive) paths++-- not very effective: it opens the archive many times, but it should work+addEntry :: FilePath -> FilePath -> IO ()+addEntry a path = do+ isADir <- doesDirectoryExist path+ if isADir+ then printErrors a path $ do+ withArchive flags a $ mapM_ checkAddDirectory $ parents path+ paths <- filter (`notElem` [".",".."]) `liftM` getDirectoryContents path+ let rpaths = map (\e -> joinPath [path,e]) paths+ add a rpaths+ else do+ printErrors a path $+ withArchive flags a $ addOrUpdate path =<< sourceFile path 0 0+ where+ flags = [CreateFlag]+ parents = scanl1 (\p c -> joinPath [p,c]) . splitDirectories+ checkAddDirectory p = do+ e1 <- nameLocate [] p+ e2 <- nameLocate [] (p ++ "/")+ if e1 == Nothing && e2 == Nothing+ then addDirectory p+ else return (-1)+ addOrUpdate p src = do+ exists <- nameLocate [] p+ case exists of+ (Just i) -> replaceFileIx i src+ Nothing -> addFile p src >> return ()+ printErrors a p action =+ catchZipError+ ( action >> return () )+ ( \ze -> hPutStrLn stderr $ intercalate ": " [a, p, show ze] )++extract :: FilePath -> FilePath -> [FilePath] -> IO ()+extract outdir archive onlyFiles =+ withArchive [] archive $ do+ n <- numFiles+ mapM_ (extractEntry outdir onlyFiles) [0..(n-1)]++-- silently overwrites existing files+extractEntry :: FilePath -> [FilePath] -> Int -> Archive ()+extractEntry outdir onlyFiles i = do+ name <- fileName [] i+ let fspath = joinPath [outdir, name]+ let fsdir = takeDirectory fspath+ when (null onlyFiles || name `elem` onlyFiles) $+ if isDir name+ then lift $ createDirectoryIfMissing True fsdir+ else do+ b <- fileContentsIx [] i+ lift $ do+ createDirectoryIfMissing True fsdir+ writeFile fspath b -- FIXME: should be binary + where+ isDir "" = False+ isDir f = last f == '/'+
+ examples/legacyUnzip.hs view
@@ -0,0 +1,38 @@+-- A simple unzip utility.+--+-- This is an example of using legacy LibZip-0.0 API.+--+module Main where++import qualified Data.ByteString as B+import Control.Monad (forM_,when)+import System.Directory (createDirectoryIfMissing)+import System.Environment (getArgs)+import System.FilePath (takeDirectory)++import Codec.Archive.LibZip++usage = "unzip [-l] file.zip [files]"++main = do+ args <- getArgs+ let onlyList = "-l" `elem` args+ let args' = filter (/= "-l") args+ case args' of+ [] -> putStrLn usage+ (filename:files) -> do+ catchZipError $+ withZip filename [] $ \z -> do+ files' <- getFiles z []+ forM_ files' $ \f -> do+ when (f `elem` files || null files) $+ if onlyList+ then putStrLn f+ else saveFile f =<< readZipFile z f []+ $ \e -> putStrLn $ "Error in " ++ filename ++ ": " ++ show e++saveFile f contents = do+ if isDir f+ then createDirectoryIfMissing True $ takeDirectory f+ else B.writeFile f contents+
+ runTests.hs view
@@ -0,0 +1,17 @@+import Tests.LegacyTests (legacyTests)+import Tests.MonadicTests (monadicTests)++import System.Exit+import Test.HUnit++allTests = TestList+ [ "Legacy API" ~: legacyTests+ , "Monadic API" ~: monadicTests+ ]++main = do+ result <- runTestTT allTests+ if (errors result + failures result) > 0+ then exitFailure+ else exitSuccess+