{- | 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, withEncryptedArchive, getZip
    , numFiles, fileName, nameLocate, fileNames
    , fileSize, fileSizeIx
    , fileStat, fileStatIx
    , deleteFile, deleteFileIx
    , renameFile, renameFileIx
    , addFile, addFileWithFlags
    , addDirectory, addDirectoryWithFlags
    , replaceFile, replaceFileIx
    , setFileCompression, setFileCompressionIx
    , 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 Bindings.LibZip
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 (when)
import Control.Monad.State.Strict
    (StateT(..), MonadState(..), MonadTrans(..), lift, liftM)
import Foreign.C.Error (Errno(..), eINVAL)
import Foreign.C.String (withCString, peekCString)
import Foreign.C.Types (CInt, CULLong)
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
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as UTF8

--
-- 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,Integer,[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 :: [OpenFlag] -> FilePath -> Archive a -> IO a
withArchive [OpenFlag]
flags FilePath
path Archive a
action =
  FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
path' ->
  (Ptr CInt -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO a) -> IO a) -> (Ptr CInt -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
errp ->
  CString -> CInt -> Ptr CInt -> IO (Ptr C'zip)
c'zip_open CString
path' ([OpenFlag] -> CInt
forall a b. (Enum a, Num b) => [a] -> b
combine [OpenFlag]
flags) Ptr CInt
errp IO (Ptr C'zip) -> (Ptr C'zip -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr C'zip
z ->
  if Ptr C'zip
z Ptr C'zip -> Ptr C'zip -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'zip
forall a. Ptr a
nullPtr
    then Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
errp IO CInt -> (CInt -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO(ZipError -> IO a) -> (CInt -> ZipError) -> CInt -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> ZipError
errFromCInt
    else Ptr C'zip -> Archive a -> IO a
forall a. Ptr C'zip -> Archive a -> IO a
withOpenArchive Ptr C'zip
z Archive a
action


-- | Top-level wrapper for operations with an open encrypted archive.
-- 'withEncryptedArchive' opens and closes the file automatically.
-- On error it throws 'ZipError'.
withEncryptedArchive :: [OpenFlag]   -- ^ Checks for consistency or existence.
                     -> String       -- ^ Encryption password.
                     -> FilePath     -- ^ Filename of the zip archive.
                     -> Archive a    -- ^ Action to don with the archive.
                     -> IO a
withEncryptedArchive :: [OpenFlag] -> FilePath -> FilePath -> Archive a -> IO a
withEncryptedArchive [OpenFlag]
flags FilePath
password FilePath
path Archive a
action =
    FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
password ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
password' ->
    FilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
path ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
path' ->
    (Ptr CInt -> IO a) -> IO a
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO a) -> IO a) -> (Ptr CInt -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
errp ->
    CString -> CInt -> Ptr CInt -> IO (Ptr C'zip)
c'zip_open CString
path' ([OpenFlag] -> CInt
forall a b. (Enum a, Num b) => [a] -> b
combine [OpenFlag]
flags) Ptr CInt
errp IO (Ptr C'zip) -> (Ptr C'zip -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr C'zip
z ->
    if Ptr C'zip
z Ptr C'zip -> Ptr C'zip -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'zip
forall a. Ptr a
nullPtr
       then Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
errp IO CInt -> (CInt -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO(ZipError -> IO a) -> (CInt -> ZipError) -> CInt -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> ZipError
errFromCInt
       else do
         CInt
r <- Ptr C'zip -> CString -> IO CInt
c'zip_set_default_password Ptr C'zip
z CString
password'
         if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
            then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO
            else Ptr C'zip -> Archive a -> IO a
forall a. Ptr C'zip -> Archive a -> IO a
withOpenArchive Ptr C'zip
z Archive a
action


withOpenArchive :: Zip -> Archive a -> IO a
withOpenArchive :: Ptr C'zip -> Archive a -> IO a
withOpenArchive Ptr C'zip
z Archive a
action = do
      a
r <- (a, Ptr C'zip) -> a
forall a b. (a, b) -> a
fst ((a, Ptr C'zip) -> a) -> IO (a, Ptr C'zip) -> IO a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Archive a -> Ptr C'zip -> IO (a, Ptr C'zip)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Archive a
action Ptr C'zip
z
      CInt
e <- Ptr C'zip -> IO CInt
c'zip_close Ptr C'zip
z
      if CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
        then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO
        else a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r


-- | Get the number of entries in the archive.
numFiles :: [FileFlag]  -- ^ 'FileUNCHANGED' can be used to return
                        -- the original unchanged number of entries.
         -> Archive Integer
numFiles :: [FileFlag] -> Archive Integer
numFiles [FileFlag]
flags  = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO Integer -> Archive Integer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Integer -> Archive Integer) -> IO Integer -> Archive Integer
forall a b. (a -> b) -> a -> b
$ CLLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLLong -> Integer) -> IO CLLong -> IO Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Ptr C'zip -> C'zip_flags_t -> IO CLLong
c'zip_get_num_entries Ptr C'zip
z ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)

-- | Get name of an entry in the archive by its index.
fileName :: [FileFlag]  -- ^ 'FileUNCHANGED' flag can be used to
                        -- return the original unchanged filename.
         -> Integer     -- ^ Position index of a file in the archive.
         -> Archive FilePath  -- ^ Name of the file in the archive.
fileName :: [FileFlag] -> Integer -> Archive FilePath
fileName [FileFlag]
flags Integer
i = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO FilePath -> Archive FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO FilePath -> Archive FilePath)
-> IO FilePath -> Archive FilePath
forall a b. (a -> b) -> a -> b
$ do
    CString
n <- Ptr C'zip -> CULLong -> C'zip_flags_t -> IO CString
c'zip_get_name Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
    Bool -> Ptr C'zip -> IO FilePath -> IO FilePath
forall a. Bool -> Ptr C'zip -> IO a -> IO a
doIf' (CString
n CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr) Ptr C'zip
z (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ CString -> IO FilePath
peekCString CString
n

-- | Locate an entry (get its index) in the archive by its name.
nameLocate :: [FileFlag]
                -- ^ Filename lookup mode.
                --   'FileNOCASE':     ignore case distinctions (only for ASCII).
                --   'FileNODIR':      ignore directory part of the file name.
                --   'FileENC_RAW':    compare against unmodified names as it is
                --                     in the ZIP archive.
                --   'FileENC_GUESS':  (default) guess encoding of the name in
                --                     the ZIP archive and convert it to UTF-8,
                --                     if necessary.
                --   'FileENC_STRICT': follow the ZIP specification and expect
                --                     CP-437 encoded names in the ZIP archive
                --                     (except if they are explicitly marked as
                --                     UTF-8). Convert it to UTF-8 before comparing.
           -> FilePath    -- ^ Name of the file in the archive.
           -> Archive (Maybe Integer)  -- ^ 'Just' position index if found.
nameLocate :: [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
name = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO (Maybe Integer) -> Archive (Maybe Integer)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe Integer) -> Archive (Maybe Integer))
-> IO (Maybe Integer) -> Archive (Maybe Integer)
forall a b. (a -> b) -> a -> b
$
    FilePath -> (CString -> IO (Maybe Integer)) -> IO (Maybe Integer)
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
name ((CString -> IO (Maybe Integer)) -> IO (Maybe Integer))
-> (CString -> IO (Maybe Integer)) -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$ \CString
name' -> do
    Integer
i <- CLLong -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CLLong -> Integer) -> IO CLLong -> IO Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Ptr C'zip -> CString -> C'zip_flags_t -> IO CLLong
c'zip_name_locate Ptr C'zip
z CString
name' ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
    if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
       then Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing
       else Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
i)

-- | Get names of all entries (files and directories) in the archive.
fileNames :: [FileFlag]  -- ^ 'FileUNCHANGED' flag is accepted.
          -> Archive [FilePath]
fileNames :: [FileFlag] -> Archive [FilePath]
fileNames [FileFlag]
flags = do
  Integer
n <- [FileFlag] -> Archive Integer
numFiles [FileFlag]
flags
  (Integer -> Archive FilePath) -> [Integer] -> Archive [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([FileFlag] -> Integer -> Archive FilePath
fileName [FileFlag]
flags) [Integer
0..Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
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 Integer -- ^ File size.
fileSize :: [FileFlag] -> FilePath -> Archive Integer
fileSize [FileFlag]
flags FilePath
name = [FileFlag] -> FilePath -> Archive ZipStat
fileStat [FileFlag]
flags FilePath
name Archive ZipStat -> (ZipStat -> Archive Integer) -> Archive Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Archive Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Archive Integer)
-> (ZipStat -> Integer) -> ZipStat -> Archive Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipStat -> Integer
zs'size

-- | Get size of a file in the archive (by index).
fileSizeIx :: [FileFlag]  -- ^ 'FileUNCHANGED' is accepted.
           -> Integer     -- ^ Position index of a file in the archive.
           -> Archive Integer -- ^ File size.
fileSizeIx :: [FileFlag] -> Integer -> Archive Integer
fileSizeIx [FileFlag]
flags Integer
i = [FileFlag] -> Integer -> Archive ZipStat
fileStatIx [FileFlag]
flags Integer
i Archive ZipStat -> (ZipStat -> Archive Integer) -> Archive Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Integer -> Archive Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Archive Integer)
-> (ZipStat -> Integer) -> ZipStat -> Archive Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipStat -> Integer
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 :: [FileFlag] -> FilePath -> Archive ZipStat
fileStat [FileFlag]
flags FilePath
name = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO ZipStat -> Archive ZipStat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ZipStat -> Archive ZipStat) -> IO ZipStat -> Archive ZipStat
forall a b. (a -> b) -> a -> b
$
       FilePath -> (CString -> IO ZipStat) -> IO ZipStat
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
name ((CString -> IO ZipStat) -> IO ZipStat)
-> (CString -> IO ZipStat) -> IO ZipStat
forall a b. (a -> b) -> a -> b
$ \CString
name' ->
       (Ptr C'zip_stat -> IO ZipStat) -> IO ZipStat
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'zip_stat -> IO ZipStat) -> IO ZipStat)
-> (Ptr C'zip_stat -> IO ZipStat) -> IO ZipStat
forall a b. (a -> b) -> a -> b
$ \Ptr C'zip_stat
stat -> do
       Ptr C'zip_stat -> IO ()
c'zip_stat_init Ptr C'zip_stat
stat
       CInt
r <- Ptr C'zip -> CString -> C'zip_flags_t -> Ptr C'zip_stat -> IO CInt
c'zip_stat Ptr C'zip
z CString
name' ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags) Ptr C'zip_stat
stat
       Bool -> Ptr C'zip -> IO ZipStat -> IO ZipStat
forall a. Bool -> Ptr C'zip -> IO a -> IO a
doIf' (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) Ptr C'zip
z (IO ZipStat -> IO ZipStat) -> IO ZipStat -> IO ZipStat
forall a b. (a -> b) -> a -> b
$ C'zip_stat -> IO ZipStat
toZipStat (C'zip_stat -> IO ZipStat) -> IO C'zip_stat -> IO ZipStat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'zip_stat -> IO C'zip_stat
forall a. Storable a => Ptr a -> IO a
peek Ptr C'zip_stat
stat

-- | Get information about a file in the archive (by index).
fileStatIx :: [FileFlag]  -- ^ 'FileUNCHANGED' can be used.
           -> Integer     -- ^ Position index of a file in the archive.
           -> Archive ZipStat  -- ^ Information about the file.
fileStatIx :: [FileFlag] -> Integer -> Archive ZipStat
fileStatIx [FileFlag]
flags Integer
i = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO ZipStat -> Archive ZipStat
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ZipStat -> Archive ZipStat) -> IO ZipStat -> Archive ZipStat
forall a b. (a -> b) -> a -> b
$
       (Ptr C'zip_stat -> IO ZipStat) -> IO ZipStat
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'zip_stat -> IO ZipStat) -> IO ZipStat)
-> (Ptr C'zip_stat -> IO ZipStat) -> IO ZipStat
forall a b. (a -> b) -> a -> b
$ \Ptr C'zip_stat
stat -> do
       CInt
r <- Ptr C'zip -> CULLong -> C'zip_flags_t -> Ptr C'zip_stat -> IO CInt
c'zip_stat_index Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags) Ptr C'zip_stat
stat
       Bool -> Ptr C'zip -> IO ZipStat -> IO ZipStat
forall a. Bool -> Ptr C'zip -> IO a -> IO a
doIf' (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0) Ptr C'zip
z (IO ZipStat -> IO ZipStat) -> IO ZipStat -> IO ZipStat
forall a b. (a -> b) -> a -> b
$ C'zip_stat -> IO ZipStat
toZipStat (C'zip_stat -> IO ZipStat) -> IO C'zip_stat -> IO ZipStat
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr C'zip_stat -> IO C'zip_stat
forall a. Storable a => Ptr a -> IO a
peek Ptr C'zip_stat
stat

-- | Delete file from the archive.
deleteFile :: [FileFlag]  -- ^ Filename lookup mode (see 'nameLocate').
           -> FilePath    -- ^ Filename.
           -> Archive ()
deleteFile :: [FileFlag] -> FilePath -> Archive ()
deleteFile [FileFlag]
flags FilePath
name = do
  Maybe Integer
mbi <- [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
name
  Archive ()
-> (Integer -> Archive ()) -> Maybe Integer -> Archive ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrNOENT) Integer -> Archive ()
deleteFileIx Maybe Integer
mbi

-- | Delete file (referenced by position index) from the archive.
deleteFileIx :: Integer  -- ^ Position index of a file in the archive.
             -> Archive ()
deleteFileIx :: Integer -> Archive ()
deleteFileIx Integer
i = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  CInt
r <- IO CInt -> StateT (Ptr C'zip) IO CInt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CInt -> StateT (Ptr C'zip) IO CInt)
-> IO CInt -> StateT (Ptr C'zip) IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> CULLong -> IO CInt
c'zip_delete Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
  if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
     then () -> Archive ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO

-- | Rename file in the archive.
renameFile :: [FileFlag]  -- ^ Filename lookup mode (see 'nameLocate').
           -> FilePath    -- ^ Old name.
           -> FilePath    -- ^ New name.
           -> Archive ()
renameFile :: [FileFlag] -> FilePath -> FilePath -> Archive ()
renameFile [FileFlag]
flags FilePath
oldname FilePath
newname = do
  Maybe Integer
mbi <- [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
oldname
  Archive ()
-> (Integer -> Archive ()) -> Maybe Integer -> Archive ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrNOENT)
            (\Integer
i -> Integer -> ByteString -> [FileFlag] -> Archive ()
renameFileIx Integer
i (FilePath -> ByteString
UTF8.fromString FilePath
newname) [FileFlag
FileENC_UTF_8])
            Maybe Integer
mbi

-- | Rename file (referenced by position index) in the archive.
renameFileIx :: Integer       -- ^ Position index of a file in the archive.
             -> BS.ByteString -- ^ New name.
             -> [FileFlag]    -- ^ Name encoding flags.
                              -- 'FileENC_GUESS': guess encoding of the name (default).
                              -- 'FileENC_UTF_8': interpret name as UTF-8.
                              -- 'FileENC_CP437': interpret name as CP-437.
             -> Archive ()
renameFileIx :: Integer -> ByteString -> [FileFlag] -> Archive ()
renameFileIx Integer
i ByteString
newname [FileFlag]
flags = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  CInt
r <- IO CInt -> StateT (Ptr C'zip) IO CInt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CInt -> StateT (Ptr C'zip) IO CInt)
-> IO CInt -> StateT (Ptr C'zip) IO CInt
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
newname ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \CString
s ->
       Ptr C'zip -> CULLong -> CString -> C'zip_flags_t -> IO CInt
c'zip_file_rename Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) CString
s ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
  if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
     then () -> Archive ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     else IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
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 :: FilePath -> ZipSource -> Archive Int
addFile FilePath
name ZipSource
src =
  let utf8name :: ByteString
utf8name = FilePath -> ByteString
UTF8.fromString FilePath
name
  in  [FileFlag] -> ByteString -> ZipSource -> Archive Int
addFileWithFlags [FileFlag
FileENC_UTF_8] ByteString
utf8name ZipSource
src

addFileWithFlags
    :: [FileFlag]   -- ^ Can be a combination of 'FileOVERWRITE' and/or one of
                    -- filename encoding flags: 'FileENC_GUESS' (default),
                    -- 'FileENC_UTF_8', 'FileENC_CP437'.
    -> BS.ByteString   -- ^ Name of the file to create.
    -> ZipSource       -- ^ Source where file data is obtained from.
    -> Archive Int     -- ^ Position index of the new file.
addFileWithFlags :: [FileFlag] -> ByteString -> ZipSource -> Archive Int
addFileWithFlags [FileFlag]
flags ByteString
namebytes ZipSource
src = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO Int -> Archive Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Int -> Archive Int) -> IO Int -> Archive Int
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO Int) -> IO Int
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
namebytes ((CString -> IO Int) -> IO Int) -> (CString -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \CString
name' -> do
    CLLong
i <- Ptr C'zip -> CString -> ZipSource -> C'zip_flags_t -> IO CLLong
c'zip_file_add Ptr C'zip
z CString
name' ZipSource
src ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
    if CLLong
i CLLong -> CLLong -> Bool
forall a. Ord a => a -> a -> Bool
< CLLong
0
       then ZipSource -> IO ()
c'zip_source_free ZipSource
src IO () -> IO ZipError -> IO ZipError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO Int
forall e a. Exception e => e -> IO a
E.throwIO
       else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ CLLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLLong
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 :: FilePath -> Archive Int
addDirectory FilePath
name =
  let utf8name :: ByteString
utf8name = FilePath -> ByteString
UTF8.fromString FilePath
name
  in  [FileFlag] -> ByteString -> Archive Int
addDirectoryWithFlags [FileFlag
FileENC_UTF_8] ByteString
utf8name

-- | Add a directory to the archive.
addDirectoryWithFlags
    :: [FileFlag]        -- ^ Can be one of filename encoding flags:
                         -- 'FileENC_GUESS (default), 'FileENC_UTF_8', 'FileENC_CP437'.
    -> BS.ByteString     -- ^ Directory's name in the archive.
    -> Archive Int       -- ^ Position index of the new directory entry.
addDirectoryWithFlags :: [FileFlag] -> ByteString -> Archive Int
addDirectoryWithFlags [FileFlag]
flags ByteString
name = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  CLLong
r <- IO CLLong -> StateT (Ptr C'zip) IO CLLong
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CLLong -> StateT (Ptr C'zip) IO CLLong)
-> IO CLLong -> StateT (Ptr C'zip) IO CLLong
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO CLLong) -> IO CLLong
forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
name ((CString -> IO CLLong) -> IO CLLong)
-> (CString -> IO CLLong) -> IO CLLong
forall a b. (a -> b) -> a -> b
$
       \CString
name'-> Ptr C'zip -> CString -> C'zip_flags_t -> IO CLLong
c'zip_dir_add Ptr C'zip
z CString
name' ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
  if CLLong
r CLLong -> CLLong -> Bool
forall a. Ord a => a -> a -> Bool
< CLLong
0
     then IO Int -> Archive Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Int -> Archive Int) -> IO Int -> Archive Int
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO Int
forall e a. Exception e => e -> IO a
E.throwIO
     else Int -> Archive Int
forall (m :: * -> *) a. Monad m => a -> m a
return (CLLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLLong
r)

-- | Replace a file in the archive.
replaceFile :: [FileFlag]  -- ^ Filename lookup mode (see 'nameLocate').
            -> FilePath    -- ^ File to replace.
            -> ZipSource   -- ^ Source where the new file data is obtained from.
            -> Archive ()
replaceFile :: [FileFlag] -> FilePath -> ZipSource -> Archive ()
replaceFile [FileFlag]
flags FilePath
name ZipSource
src = do
  Maybe Integer
mbi <- [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
name
  Archive ()
-> (Integer -> Archive ()) -> Maybe Integer -> Archive ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ ZipSource -> IO ()
c'zip_source_free ZipSource
src IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrNOENT)
        (\Integer
i -> Integer -> ZipSource -> Archive ()
replaceFileIx Integer
i ZipSource
src Archive () -> Archive () -> Archive ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Archive ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe Integer
mbi

-- | Set compression method for a file in the archive.
setFileCompression
    :: [FileFlag]   -- ^ Filename lookup mode (see 'nameLocate').
    -> FilePath     -- ^ Filename.
    -> ZipCompMethod  -- ^ Compression method.
                      -- As of libzip 0.11, the following methods are supported:
                      -- 'CompDEFAULT', 'CompSTORE', 'CompDEFLATE'.
    -> Archive ()
setFileCompression :: [FileFlag] -> FilePath -> ZipCompMethod -> Archive ()
setFileCompression [FileFlag]
flags FilePath
name ZipCompMethod
method = do
  Maybe Integer
mbi <- [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
name
  Archive ()
-> (Integer -> Archive ()) -> Maybe Integer -> Archive ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrNOENT) (\Integer
i -> Integer -> ZipCompMethod -> Archive ()
setFileCompressionIx Integer
i ZipCompMethod
method) Maybe Integer
mbi

-- | Set compression method for a file in the archive.
setFileCompressionIx
    :: Integer   -- ^ Position index of a file in the archive.
    -> ZipCompMethod  -- ^ Compression method.
                      -- As of libzip 0.11, the following methods are supported:
                      -- 'CompDEFAULT', 'CompSTORE', 'CompDEFLATE'.
    -> Archive ()
setFileCompressionIx :: Integer -> ZipCompMethod -> Archive ()
setFileCompressionIx Integer
i ZipCompMethod
method = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ do
    CInt
r <- Ptr C'zip -> CULLong -> CInt -> C'zip_flags_t -> IO CInt
c'zip_set_file_compression Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ZipCompMethod -> Int) -> ZipCompMethod -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipCompMethod -> Int
forall a. Enum a => a -> Int
fromEnum (ZipCompMethod -> CInt) -> ZipCompMethod -> CInt
forall a b. (a -> b) -> a -> b
$ ZipCompMethod
method) C'zip_flags_t
0
    if CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
       then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
       else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Replace a file in the archive (referenced by position index).
replaceFileIx :: Integer   -- ^ Position index of a file in the archive.
              -> ZipSource -- ^ Source where the new file data is obtained from
              -> Archive ()
replaceFileIx :: Integer -> ZipSource -> Archive ()
replaceFileIx Integer
i ZipSource
src = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ do
    CInt
r <- Ptr C'zip -> CULLong -> ZipSource -> C'zip_flags_t -> IO CInt
c'zip_file_replace Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) ZipSource
src C'zip_flags_t
0
    if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
       then ZipSource -> IO ()
c'zip_source_free ZipSource
src IO () -> IO ZipError -> IO ZipError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
       else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Create a data source. Note: input is converted to @[Word8]@ internally.
sourceBuffer :: (Enum a)
             => [a]
             -> Archive ZipSource
sourceBuffer :: [a] -> Archive ZipSource
sourceBuffer [a]
src = do
  let ws :: [Word8]
ws = (a -> Word8) -> [a] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (a -> Int) -> a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum) [a]
src :: [Word8]
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO ZipSource -> Archive ZipSource
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ZipSource -> Archive ZipSource)
-> IO ZipSource -> Archive ZipSource
forall a b. (a -> b) -> a -> b
$ [Word8] -> (Int -> Ptr Word8 -> IO ZipSource) -> IO ZipSource
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Word8]
ws ((Int -> Ptr Word8 -> IO ZipSource) -> IO ZipSource)
-> (Int -> Ptr Word8 -> IO ZipSource) -> IO ZipSource
forall a b. (a -> b) -> a -> b
$ \Int
len Ptr Word8
buf -> do
      ZipSource
zs <- Ptr C'zip -> Ptr () -> CULLong -> CInt -> IO ZipSource
c'zip_source_buffer Ptr C'zip
z (Ptr Word8 -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) (Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) CInt
0
      if ZipSource
zs ZipSource -> ZipSource -> Bool
forall a. Eq a => a -> a -> Bool
== ZipSource
forall a. Ptr a
nullPtr
         then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ZipSource) -> IO ZipSource
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ZipSource
forall e a. Exception e => e -> IO a
E.throwIO
         else ZipSource -> IO ZipSource
forall (m :: * -> *) a. Monad m => a -> m a
return ZipSource
zs

-- | Create a data source from a file.
sourceFile :: FilePath   -- ^ File to open.
           -> Integer    -- ^ Offset from the beginning of the file.
           -> Integer    -- ^ The number of bytes to read. If @0@ or @-1@,
                         -- the read till the end of file.
           -> Archive ZipSource
sourceFile :: FilePath -> Integer -> Integer -> Archive ZipSource
sourceFile FilePath
name Integer
offset Integer
len = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO ZipSource -> Archive ZipSource
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ZipSource -> Archive ZipSource)
-> IO ZipSource -> Archive ZipSource
forall a b. (a -> b) -> a -> b
$ FilePath -> (CString -> IO ZipSource) -> IO ZipSource
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
name ((CString -> IO ZipSource) -> IO ZipSource)
-> (CString -> IO ZipSource) -> IO ZipSource
forall a b. (a -> b) -> a -> b
$ \CString
name' -> do
      ZipSource
zs <- Ptr C'zip -> CString -> CULLong -> CLLong -> IO ZipSource
c'zip_source_file Ptr C'zip
z CString
name' (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset) (Integer -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len)
      if ZipSource
zs ZipSource -> ZipSource -> Bool
forall a. Eq a => a -> a -> Bool
== ZipSource
forall a. Ptr a
nullPtr
         then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ZipSource) -> IO ZipSource
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ZipSource
forall e a. Exception e => e -> IO a
E.throwIO
         else ZipSource -> IO ZipSource
forall (m :: * -> *) a. Monad m => a -> m a
return ZipSource
zs

-- | Create a data source from a file in the zip archive.
sourceZip :: [FileFlag]  -- ^ 'FileUNCHANGED' and 'FileRECOMPRESS' can be used.
          -> Zip         -- ^ Source archive.
          -> Integer     -- ^ Position index of a file in the source archive.
          -> Integer     -- ^ Offset from the beginning of the file.
          -> Integer     -- ^ The number of bytes to read. If @0@ or @-1@,
                         -- then read till the end of file.
          -> Archive ZipSource
sourceZip :: [FileFlag]
-> Ptr C'zip -> Integer -> Integer -> Integer -> Archive ZipSource
sourceZip [FileFlag]
flags Ptr C'zip
srcz Integer
srcidx Integer
offset Integer
len = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO ZipSource -> Archive ZipSource
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ZipSource -> Archive ZipSource)
-> IO ZipSource -> Archive ZipSource
forall a b. (a -> b) -> a -> b
$ do
    ZipSource
zs <- Ptr C'zip
-> Ptr C'zip
-> CULLong
-> C'zip_flags_t
-> CULLong
-> CLLong
-> IO ZipSource
c'zip_source_zip Ptr C'zip
z Ptr C'zip
srcz (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
srcidx)
          ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags) (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
offset) (Integer -> CLLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
len)
    if ZipSource
zs ZipSource -> ZipSource -> Bool
forall a. Eq a => a -> a -> Bool
== ZipSource
forall a. Ptr a
nullPtr
       then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ZipSource) -> IO ZipSource
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ZipSource
forall e a. Exception e => e -> IO a
E.throwIO
       else ZipSource -> IO ZipSource
forall (m :: * -> *) a. Monad m => a -> m a
return ZipSource
zs

-- | Create a data source from a 'PureSource'.
-- Note: input of @[a]@ is converted to @[Word8]@ internally.
sourcePure :: (Enum a, Storable a, Storable st, Integral szt)
           => PureSource a st szt -> Archive ZipSource
sourcePure :: PureSource a st szt -> Archive ZipSource
sourcePure PureSource a st szt
pureSrc = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO ZipSource -> Archive ZipSource
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ZipSource -> Archive ZipSource)
-> IO ZipSource -> Archive ZipSource
forall a b. (a -> b) -> a -> b
$ do
    C'zip_source_callback
cb <- (Ptr () -> Ptr () -> CULLong -> C'zip_flags_t -> IO CULLong)
-> IO C'zip_source_callback
mk'zip_source_callback (PureSource a st szt
-> Ptr () -> Ptr () -> CULLong -> C'zip_flags_t -> IO CULLong
forall a st szt.
(Enum a, Storable a, Storable st, Integral szt) =>
PureSource a st szt
-> Ptr () -> Ptr () -> CULLong -> C'zip_flags_t -> IO CULLong
runPureSource PureSource a st szt
pureSrc)
    ZipSource
zs <- st -> (Ptr st -> IO ZipSource) -> IO ZipSource
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (PureSource a st szt -> st
forall a st szt. PureSource a st szt -> st
srcState PureSource a st szt
pureSrc) ((Ptr st -> IO ZipSource) -> IO ZipSource)
-> (Ptr st -> IO ZipSource) -> IO ZipSource
forall a b. (a -> b) -> a -> b
$
          \Ptr st
pState -> Ptr C'zip -> C'zip_source_callback -> Ptr () -> IO ZipSource
c'zip_source_function Ptr C'zip
z C'zip_source_callback
cb (Ptr st -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr st
pState)
    if ZipSource
zs ZipSource -> ZipSource -> Bool
forall a. Eq a => a -> a -> Bool
== ZipSource
forall a. Ptr a
nullPtr
       then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ZipSource) -> IO ZipSource
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ZipSource
forall e a. Exception e => e -> IO a
E.throwIO
       else ZipSource -> IO ZipSource
forall (m :: * -> *) a. Monad m => a -> m a
return ZipSource
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 PureSource a st szt = PureSource {
    PureSource a st szt -> st
srcState :: st     -- ^ Initial state of the source.
  , PureSource a st szt -> szt
srcSize  :: szt    -- ^ Total size of the data.
  , PureSource a st szt -> Maybe UTCTime
srcMTime :: Maybe UTCTime
                -- ^ Modification time (current time if Nothing).
  , PureSource a st szt -> szt -> st -> Maybe (szt, [a], st)
readSrc  :: szt -> st -> Maybe (szt, [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, Integral szt) =>
       PureSource a st szt
    -> (Ptr () -> Ptr () -> CULLong -> C'zip_source_cmd -> IO CULLong)
runPureSource :: PureSource a st szt
-> Ptr () -> Ptr () -> CULLong -> C'zip_flags_t -> IO CULLong
runPureSource PureSource a st szt
src Ptr ()
pState Ptr ()
pData CULLong
len C'zip_flags_t
cmd
  | C'zip_flags_t
cmd C'zip_flags_t -> C'zip_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'zip_flags_t
forall a. Num a => a
c'ZIP_SOURCE_OPEN = CULLong -> IO CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return CULLong
0
  | C'zip_flags_t
cmd C'zip_flags_t -> C'zip_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'zip_flags_t
forall a. Num a => a
c'ZIP_SOURCE_READ = do
      st
s <- Ptr st -> IO st
forall a. Storable a => Ptr a -> IO a
peek (Ptr () -> Ptr st
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pState :: Ptr st)
      case PureSource a st szt -> szt -> st -> Maybe (szt, [a], st)
forall a st szt.
PureSource a st szt -> szt -> st -> Maybe (szt, [a], st)
readSrc (PureSource a st szt
src { srcState :: st
srcState = st
s }) (CULLong -> szt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CULLong
len) st
s of
        Just (szt
len',[a]
bs,st
s') -> do
          Ptr Word8 -> [Word8] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (Ptr () -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pData :: Ptr Word8) ((a -> Word8) -> [a] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a. Enum a => Int -> a
toEnum(Int -> Word8) -> (a -> Int) -> a -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
.a -> Int
forall a. Enum a => a -> Int
fromEnum) [a]
bs)
          Ptr st -> st -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr () -> Ptr st
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pState) st
s'
          CULLong -> IO CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (szt -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral szt
len')
        Maybe (szt, [a], st)
Nothing -> CULLong -> IO CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (-CULLong
1)
  | C'zip_flags_t
cmd C'zip_flags_t -> C'zip_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'zip_flags_t
forall a. Num a => a
c'ZIP_SOURCE_CLOSE = CULLong -> IO CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return CULLong
0
  | C'zip_flags_t
cmd C'zip_flags_t -> C'zip_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'zip_flags_t
forall a. Num a => a
c'ZIP_SOURCE_STAT = do
      UTCTime
t <- IO UTCTime
-> (UTCTime -> IO UTCTime) -> Maybe UTCTime -> IO UTCTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO UTCTime
getCurrentTime UTCTime -> IO UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (PureSource a st szt -> Maybe UTCTime
forall a st szt. PureSource a st szt -> Maybe UTCTime
srcMTime PureSource a st szt
src)
      let pt :: CTime
pt = Integer -> CTime
forall a. Num a => Integer -> a
fromInteger (Integer -> CTime) -> (UTCTime -> Integer) -> UTCTime -> CTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Integer)
-> (UTCTime -> POSIXTime) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> CTime) -> UTCTime -> CTime
forall a b. (a -> b) -> a -> b
$ UTCTime
t
      let pStat :: Ptr b
pStat = Ptr () -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pData
      Ptr C'zip_stat -> IO ()
c'zip_stat_init Ptr C'zip_stat
forall a. Ptr a
pStat
      C'zip_stat
stat <- Ptr C'zip_stat -> IO C'zip_stat
forall a. Storable a => Ptr a -> IO a
peek Ptr C'zip_stat
forall a. Ptr a
pStat
      let stat' :: C'zip_stat
stat' = C'zip_stat
stat { c'zip_stat'mtime :: CTime
c'zip_stat'mtime = CTime
pt
                       , c'zip_stat'size :: CULLong
c'zip_stat'size = szt -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (szt -> CULLong) -> szt -> CULLong
forall a b. (a -> b) -> a -> b
$ PureSource a st szt -> szt
forall a st szt. PureSource a st szt -> szt
srcSize PureSource a st szt
src }
      Ptr C'zip_stat -> C'zip_stat -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr C'zip_stat
forall a. Ptr a
pStat C'zip_stat
stat'
      CULLong -> IO CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> IO CULLong) -> CULLong -> IO CULLong
forall a b. (a -> b) -> a -> b
$ Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (C'zip_stat -> Int
forall a. Storable a => a -> Int
sizeOf C'zip_stat
stat')
  | C'zip_flags_t
cmd C'zip_flags_t -> C'zip_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'zip_flags_t
forall a. Num a => a
c'ZIP_SOURCE_ERROR = do
      let pErrs :: Ptr CInt
pErrs = Ptr () -> Ptr CInt
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
pData :: Ptr CInt
      Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CInt
pErrs (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ZipError -> Int) -> ZipError -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipError -> Int
forall a. Enum a => a -> Int
fromEnum (ZipError -> CInt) -> ZipError -> CInt
forall a b. (a -> b) -> a -> b
$ ZipError
ErrINVAL)
      let (Errno CInt
esys) = Errno
eINVAL
      Ptr CInt -> Int -> CInt -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff Ptr CInt
pErrs Int
1 CInt
esys
      CULLong -> IO CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (CULLong -> IO CULLong) -> CULLong -> IO CULLong
forall a b. (a -> b) -> a -> b
$ Int -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* CInt -> Int
forall a. Storable a => a -> Int
sizeOf CInt
esys)
  | C'zip_flags_t
cmd C'zip_flags_t -> C'zip_flags_t -> Bool
forall a. Eq a => a -> a -> Bool
== C'zip_flags_t
forall a. Num a => a
c'ZIP_SOURCE_FREE = CULLong -> IO CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return CULLong
0
  | Bool
otherwise = CULLong -> IO CULLong
forall (m :: * -> *) a. Monad m => a -> m a
return (-CULLong
1)

-- | Get zip archive comment.
getComment :: [FileFlag]  -- ^ Can be a combination of 'FileUNCHANGED' and/or
                          -- one of 'FileENC_GUESS' (default), 'FileENC_STRICT' (CP-437).
           -> Archive (Maybe String)
getComment :: [FileFlag] -> Archive (Maybe FilePath)
getComment [FileFlag]
flags = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  (CString
c,CInt
n) <- IO (CString, CInt) -> StateT (Ptr C'zip) IO (CString, CInt)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (CString, CInt) -> StateT (Ptr C'zip) IO (CString, CInt))
-> IO (CString, CInt) -> StateT (Ptr C'zip) IO (CString, CInt)
forall a b. (a -> b) -> a -> b
$ (Ptr CInt -> IO (CString, CInt)) -> IO (CString, CInt)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (CString, CInt)) -> IO (CString, CInt))
-> (Ptr CInt -> IO (CString, CInt)) -> IO (CString, CInt)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
lenp -> do
         CString
c <- Ptr C'zip -> Ptr CInt -> C'zip_flags_t -> IO CString
c'zip_get_archive_comment Ptr C'zip
z Ptr CInt
lenp ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
         CInt
n <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
lenp
         (CString, CInt) -> IO (CString, CInt)
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
c,CInt
n)
  if  CString
c CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
    then Maybe FilePath -> Archive (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
    else IO (Maybe FilePath) -> Archive (Maybe FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe FilePath) -> Archive (Maybe FilePath))
-> IO (Maybe FilePath) -> Archive (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
BS.packCStringLen (CString
c, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n) IO ByteString
-> (ByteString -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> (ByteString -> Maybe FilePath)
-> ByteString
-> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (ByteString -> FilePath) -> ByteString -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
UTF8.toString

-- | Set zip archive comment.
setComment :: String   -- ^ Comment message.
           -> Archive ()
setComment :: FilePath -> Archive ()
setComment FilePath
msg = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  let utf8msg :: ByteString
utf8msg = FilePath -> ByteString
UTF8.fromString FilePath
msg
  CInt
r <- IO CInt -> StateT (Ptr C'zip) IO CInt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CInt -> StateT (Ptr C'zip) IO CInt)
-> IO CInt -> StateT (Ptr C'zip) IO CInt
forall a b. (a -> b) -> a -> b
$ ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
utf8msg ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(CString
msg',Int
i') ->
       Ptr C'zip -> CString -> CUShort -> IO CInt
c'zip_set_archive_comment Ptr C'zip
z CString
msg' (Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i')
  if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
     then IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
     else () -> Archive ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Remove zip archive comment.
removeComment :: Archive ()
removeComment :: Archive ()
removeComment = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  CInt
r <- IO CInt -> StateT (Ptr C'zip) IO CInt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CInt -> StateT (Ptr C'zip) IO CInt)
-> IO CInt -> StateT (Ptr C'zip) IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> CString -> CUShort -> IO CInt
c'zip_set_archive_comment Ptr C'zip
z CString
forall a. Ptr a
nullPtr CUShort
0
  if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
     then IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
     else () -> Archive ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Get comment for a file in the archive.
getFileComment :: [FileFlag]  -- ^ Filename lookup mode (see 'nameLocate').
               -> FilePath    -- ^ Filename
               -> Archive (Maybe String)
getFileComment :: [FileFlag] -> FilePath -> Archive (Maybe FilePath)
getFileComment [FileFlag]
flags FilePath
name = do
  Maybe Integer
mbi <- [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
name
  -- Backwards compatibility with LibZip < 0.11: FileUNCHANGED flag from
  -- the filename lookup mode was used to get the original unchanged comment.
  -- Please don't rely on this feature and use 'getFileCommentIx' instead.
  let comment_flags :: [FileFlag]
comment_flags = (FileFlag -> Bool) -> [FileFlag] -> [FileFlag]
forall a. (a -> Bool) -> [a] -> [a]
filter (FileFlag -> FileFlag -> Bool
forall a. Eq a => a -> a -> Bool
== FileFlag
FileUNCHANGED) [FileFlag]
flags
  Archive (Maybe FilePath)
-> (Integer -> Archive (Maybe FilePath))
-> Maybe Integer
-> Archive (Maybe FilePath)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO (Maybe FilePath) -> Archive (Maybe FilePath)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe FilePath) -> Archive (Maybe FilePath))
-> IO (Maybe FilePath) -> Archive (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ ZipError -> IO (Maybe FilePath)
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrNOENT)
            (\Integer
i -> do
                 Maybe ByteString
mbs <- [FileFlag] -> Integer -> Archive (Maybe ByteString)
getFileCommentIx [FileFlag]
comment_flags Integer
i
                 -- 'FileENC_GUESS' is default => mbs is UTF-8 encoded
                 Maybe FilePath -> Archive (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> Archive (Maybe FilePath))
-> Maybe FilePath -> Archive (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (ByteString -> FilePath) -> Maybe ByteString -> Maybe FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ByteString -> FilePath
UTF8.toString Maybe ByteString
mbs
            ) Maybe Integer
mbi

-- | Get comment for a file in the archive (referenced by position index).
getFileCommentIx :: [FileFlag]  -- ^ Comment lookup flags.
                          --   'FileUNCHANGED':  return the original unchanged comment.
                          --   'FileENC_RAW':    return the unmodified commment as it is.
                          --   'FileENC_GUESS':  (default) guess the encoding of the comment
                          --                     and convert it to UTF-8, if necessary.
                          --   'FileENC_STRICT': follow the ZIP specification for file names
                          --                     and extend it to file comments, expect
                          --                     them to be encoded in CP-437. Convert it
                          --                     to UTF-8.
                 -> Integer     -- ^ Position index of the file.
                 -> Archive (Maybe BS.ByteString)
getFileCommentIx :: [FileFlag] -> Integer -> Archive (Maybe ByteString)
getFileCommentIx [FileFlag]
flags Integer
i = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  (CString
c,C'zip_flags_t
n) <- IO (CString, C'zip_flags_t)
-> StateT (Ptr C'zip) IO (CString, C'zip_flags_t)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (CString, C'zip_flags_t)
 -> StateT (Ptr C'zip) IO (CString, C'zip_flags_t))
-> IO (CString, C'zip_flags_t)
-> StateT (Ptr C'zip) IO (CString, C'zip_flags_t)
forall a b. (a -> b) -> a -> b
$ (Ptr C'zip_flags_t -> IO (CString, C'zip_flags_t))
-> IO (CString, C'zip_flags_t)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr C'zip_flags_t -> IO (CString, C'zip_flags_t))
 -> IO (CString, C'zip_flags_t))
-> (Ptr C'zip_flags_t -> IO (CString, C'zip_flags_t))
-> IO (CString, C'zip_flags_t)
forall a b. (a -> b) -> a -> b
$ \Ptr C'zip_flags_t
lenp -> do
           CString
c <- Ptr C'zip
-> CULLong -> Ptr C'zip_flags_t -> C'zip_flags_t -> IO CString
c'zip_file_get_comment Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) Ptr C'zip_flags_t
lenp ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
           C'zip_flags_t
n <- Ptr C'zip_flags_t -> IO C'zip_flags_t
forall a. Storable a => Ptr a -> IO a
peek Ptr C'zip_flags_t
lenp
           (CString, C'zip_flags_t) -> IO (CString, C'zip_flags_t)
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
c,C'zip_flags_t
n)
  if CString
c CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
     then Maybe ByteString -> Archive (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
     else IO (Maybe ByteString) -> Archive (Maybe ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe ByteString) -> Archive (Maybe ByteString))
-> IO (Maybe ByteString) -> Archive (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ CStringLen -> IO ByteString
BS.packCStringLen (CString
c,C'zip_flags_t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral C'zip_flags_t
n) IO ByteString
-> (ByteString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> IO (Maybe ByteString))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> IO (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just

-- | Set comment for a file in the archive.
setFileComment :: [FileFlag]   -- ^ Filename lookup mode (see 'nameLocate').
               -> FilePath     -- ^ Filename.
               -> String       -- ^ New file comment.
               -> Archive ()
setFileComment :: [FileFlag] -> FilePath -> FilePath -> Archive ()
setFileComment [FileFlag]
flags FilePath
path FilePath
comment = do
  Maybe Integer
mbi <- [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
path
  let utf8comment :: ByteString
utf8comment = FilePath -> ByteString
UTF8.fromString FilePath
comment
  let cflags :: [FileFlag]
cflags = [FileFlag
FileENC_UTF_8]
  Archive ()
-> (Integer -> Archive ()) -> Maybe Integer -> Archive ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrNOENT)
            (\Integer
i -> Integer -> ByteString -> [FileFlag] -> Archive ()
setFileCommentIx Integer
i ByteString
utf8comment [FileFlag]
cflags)
            Maybe Integer
mbi

-- | Set comment for a file in the archive (referenced by position index).
setFileCommentIx :: Integer        -- ^ Position index of a file in the archive.
                 -> BS.ByteString  -- ^ New file comment.
                 -> [FileFlag]     -- ^ Comment encoding flags.
                                   -- 'FileENC_GUESS': guess encoding of the comment (default).
                                   -- 'FileENC_UTF_8': interpret comment as UTF-8.
                                   -- 'FileENC_CP437': interpret comment as CP-437.
                 -> Archive ()
setFileCommentIx :: Integer -> ByteString -> [FileFlag] -> Archive ()
setFileCommentIx Integer
i ByteString
comment [FileFlag]
cflags = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  CInt
r <- IO CInt -> StateT (Ptr C'zip) IO CInt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CInt -> StateT (Ptr C'zip) IO CInt)
-> IO CInt -> StateT (Ptr C'zip) IO CInt
forall a b. (a -> b) -> a -> b
$ ByteString -> (CStringLen -> IO CInt) -> IO CInt
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
comment ((CStringLen -> IO CInt) -> IO CInt)
-> (CStringLen -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \(CString
msg,Int
len) ->
       Ptr C'zip
-> CULLong -> CString -> CUShort -> C'zip_flags_t -> IO CInt
c'zip_file_set_comment Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) CString
msg (Int -> CUShort
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
cflags)
  if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
     then IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
     else () -> Archive ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Remove comment for a file in the archive.
removeFileComment :: [FileFlag]  -- ^ Filename lookup mode (see 'nameLocate').
                  -> FilePath    -- ^ Filename.
                  -> Archive ()
removeFileComment :: [FileFlag] -> FilePath -> Archive ()
removeFileComment [FileFlag]
flags FilePath
path = do
  Maybe Integer
mbi <- [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
path
  Archive ()
-> (Integer -> Archive ()) -> Maybe Integer -> Archive ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrNOENT) Integer -> Archive ()
removeFileCommentIx Maybe Integer
mbi

-- | Remove comment for a file in the archive (referenced by position index).
removeFileCommentIx :: Integer -- ^ Position index of a file in the archive.
                    -> Archive ()
removeFileCommentIx :: Integer -> Archive ()
removeFileCommentIx Integer
i = do
  let flags :: C'zip_flags_t
flags = C'zip_flags_t
0   -- file name encoding flags (*_FL_*) are irrelevant
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  CInt
r <- IO CInt -> StateT (Ptr C'zip) IO CInt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CInt -> StateT (Ptr C'zip) IO CInt)
-> IO CInt -> StateT (Ptr C'zip) IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr C'zip
-> CULLong -> CString -> CUShort -> C'zip_flags_t -> IO CInt
c'zip_file_set_comment Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) CString
forall a. Ptr a
nullPtr CUShort
0 C'zip_flags_t
flags
  if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
     then IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
     else () -> Archive ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Undo changes to a file in the archive.
unchangeFile :: [FileFlag]  -- ^ Filename lookup mode (see 'nameLocate').
             -> FilePath    -- ^ Filename.
             -> Archive ()
unchangeFile :: [FileFlag] -> FilePath -> Archive ()
unchangeFile [FileFlag]
flags FilePath
name = do
  Maybe Integer
mbi <- [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
name
  Archive ()
-> (Integer -> Archive ()) -> Maybe Integer -> Archive ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ ZipError -> IO ()
forall a e. Exception e => e -> a
E.throw ZipError
ErrNOENT) Integer -> Archive ()
unchangeFileIx Maybe Integer
mbi

-- | Undo changes to a file in the archive (referenced by position index).
unchangeFileIx :: Integer  -- ^ Position index of a file in the archive.
               -> Archive ()
unchangeFileIx :: Integer -> Archive ()
unchangeFileIx Integer
i = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ do
    CInt
r <- Ptr C'zip -> CULLong -> IO CInt
c'zip_unchange Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
    if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
       then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
       else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Undo global changes to zip archive (revert changes to the archive
-- comment and global flags).
unchangeArchive :: Archive ()
unchangeArchive :: Archive ()
unchangeArchive = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ do
    CInt
r <- Ptr C'zip -> IO CInt
c'zip_unchange_archive Ptr C'zip
z
    if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
       then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
       else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Undo all changes in a zip archive.
unchangeAll :: Archive ()
unchangeAll :: Archive ()
unchangeAll = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Archive ()) -> IO () -> Archive ()
forall a b. (a -> b) -> a -> b
$ do
    CInt
r <- Ptr C'zip -> IO CInt
c'zip_unchange_all Ptr C'zip
z
    if CInt
r CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0
       then Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO
       else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
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 :: [FileFlag] -> FilePath -> Entry a -> Archive a
fromFile [FileFlag]
flags FilePath
name Entry a
action = do
    Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
    [FileFlag] -> FilePath -> Archive (Maybe Integer)
nameLocate [FileFlag]
flags FilePath
name Archive (Maybe Integer)
-> (Maybe Integer -> Archive a) -> Archive a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Archive a -> (Integer -> Archive a) -> Maybe Integer -> Archive a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO a -> Archive a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> Archive a) -> IO a -> Archive a
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO) Integer -> Archive a
runAction
  where
    runAction :: Integer -> Archive a
runAction Integer
i = do
      Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
      Ptr C'zip_file
zf <- IO (Ptr C'zip_file) -> StateT (Ptr C'zip) IO (Ptr C'zip_file)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr C'zip_file) -> StateT (Ptr C'zip) IO (Ptr C'zip_file))
-> IO (Ptr C'zip_file) -> StateT (Ptr C'zip) IO (Ptr C'zip_file)
forall a b. (a -> b) -> a -> b
$ FilePath -> (CString -> IO (Ptr C'zip_file)) -> IO (Ptr C'zip_file)
forall a. FilePath -> (CString -> IO a) -> IO a
withCString FilePath
name ((CString -> IO (Ptr C'zip_file)) -> IO (Ptr C'zip_file))
-> (CString -> IO (Ptr C'zip_file)) -> IO (Ptr C'zip_file)
forall a b. (a -> b) -> a -> b
$ \CString
n -> Ptr C'zip -> CString -> C'zip_flags_t -> IO (Ptr C'zip_file)
c'zip_fopen Ptr C'zip
z CString
n ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
      if Ptr C'zip_file
zf Ptr C'zip_file -> Ptr C'zip_file -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'zip_file
forall a. Ptr a
nullPtr
        then IO a -> Archive a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> Archive a) -> IO a -> Archive a
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO
        else do
          a
r <- (a, (Ptr C'zip_file, Integer, [FileFlag])) -> a
forall a b. (a, b) -> a
fst ((a, (Ptr C'zip_file, Integer, [FileFlag])) -> a)
-> StateT (Ptr C'zip) IO (a, (Ptr C'zip_file, Integer, [FileFlag]))
-> Archive a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Entry a
-> (Ptr C'zip_file, Integer, [FileFlag])
-> StateT (Ptr C'zip) IO (a, (Ptr C'zip_file, Integer, [FileFlag]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Entry a
action (Ptr C'zip_file
zf,Integer
i,[FileFlag]
flags)
          CInt
e <- IO CInt -> StateT (Ptr C'zip) IO CInt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CInt -> StateT (Ptr C'zip) IO CInt)
-> IO CInt -> StateT (Ptr C'zip) IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr C'zip_file -> IO CInt
c'zip_fclose Ptr C'zip_file
zf
          if CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
            then IO a -> Archive a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> Archive a) -> IO a -> Archive a
forall a b. (a -> b) -> a -> b
$ ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (ZipError -> IO a) -> ZipError -> IO a
forall a b. (a -> b) -> a -> b
$ (Int -> ZipError
forall a. Enum a => Int -> a
toEnum (Int -> ZipError) -> (CInt -> Int) -> CInt -> ZipError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> ZipError) -> CInt -> ZipError
forall a b. (a -> b) -> a -> b
$ CInt
e :: ZipError)
            else a -> Archive a
forall (m :: * -> *) a. Monad m => a -> m a
return a
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.
           -> Integer    -- ^ Position index of a file in the archive.
           -> Entry a    -- ^ Action with the file.
           -> Archive a
fromFileIx :: [FileFlag] -> Integer -> Entry a -> Archive a
fromFileIx [FileFlag]
flags Integer
i Entry a
action = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
getZip
  Ptr C'zip_file
zf <- IO (Ptr C'zip_file) -> StateT (Ptr C'zip) IO (Ptr C'zip_file)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr C'zip_file) -> StateT (Ptr C'zip) IO (Ptr C'zip_file))
-> IO (Ptr C'zip_file) -> StateT (Ptr C'zip) IO (Ptr C'zip_file)
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> CULLong -> C'zip_flags_t -> IO (Ptr C'zip_file)
c'zip_fopen_index Ptr C'zip
z (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i) ([FileFlag] -> C'zip_flags_t
forall a b. (Enum a, Num b) => [a] -> b
combine [FileFlag]
flags)
  if Ptr C'zip_file
zf Ptr C'zip_file -> Ptr C'zip_file -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'zip_file
forall a. Ptr a
nullPtr
     then IO a -> Archive a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> Archive a) -> IO a -> Archive a
forall a b. (a -> b) -> a -> b
$ Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO
     else do
       a
r <- (a, (Ptr C'zip_file, Integer, [FileFlag])) -> a
forall a b. (a, b) -> a
fst ((a, (Ptr C'zip_file, Integer, [FileFlag])) -> a)
-> StateT (Ptr C'zip) IO (a, (Ptr C'zip_file, Integer, [FileFlag]))
-> Archive a
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Entry a
-> (Ptr C'zip_file, Integer, [FileFlag])
-> StateT (Ptr C'zip) IO (a, (Ptr C'zip_file, Integer, [FileFlag]))
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT Entry a
action (Ptr C'zip_file
zf,Integer
i,[FileFlag]
flags)
       CInt
e <- IO CInt -> StateT (Ptr C'zip) IO CInt
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO CInt -> StateT (Ptr C'zip) IO CInt)
-> IO CInt -> StateT (Ptr C'zip) IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr C'zip_file -> IO CInt
c'zip_fclose Ptr C'zip_file
zf
       if CInt
e CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
          then IO a -> Archive a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO a -> Archive a) -> IO a -> Archive a
forall a b. (a -> b) -> a -> b
$ ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (ZipError -> IO a) -> ZipError -> IO a
forall a b. (a -> b) -> a -> b
$ (Int -> ZipError
forall a. Enum a => Int -> a
toEnum (Int -> ZipError) -> (CInt -> Int) -> CInt -> ZipError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> ZipError) -> CInt -> ZipError
forall a b. (a -> b) -> a -> b
$ CInt
e :: ZipError)
          else a -> Archive a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

-- | Read at most @n@ bytes from the file.
readBytes ::
    (Enum a)
    => Integer   -- ^ The number of bytes to read.
    -> Entry [a] -- ^ Bytes read.
readBytes :: Integer -> Entry [a]
readBytes Integer
n = do
  Archive ()
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Archive ()
 -> StateT
      (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ())
-> (IO () -> Archive ())
-> IO ()
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> Archive ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ()
 -> StateT
      (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ())
-> IO ()
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ()
forall a b. (a -> b) -> a -> b
$
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound::Int))
      (ZipError -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrMEMORY) -- allocaArray can't allocate > (maxBound::Int)
  (Ptr C'zip_file
zf,Integer
_,[FileFlag]
_) <- StateT
  (Ptr C'zip_file, Integer, [FileFlag])
  (StateT (Ptr C'zip) IO)
  (Ptr C'zip_file, Integer, [FileFlag])
forall s (m :: * -> *). MonadState s m => m s
get
  StateT (Ptr C'zip) IO [a] -> Entry [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Ptr C'zip) IO [a] -> Entry [a])
-> (IO [a] -> StateT (Ptr C'zip) IO [a]) -> IO [a] -> Entry [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [a] -> StateT (Ptr C'zip) IO [a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [a] -> Entry [a]) -> IO [a] -> Entry [a]
forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word8 -> IO [a]) -> IO [a]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n) ((Ptr Word8 -> IO [a]) -> IO [a])
-> (Ptr Word8 -> IO [a]) -> IO [a]
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> do
         CLLong
nread <- Ptr C'zip_file -> Ptr () -> CULLong -> IO CLLong
c'zip_fread Ptr C'zip_file
zf (Ptr Word8 -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
buf) (Integer -> CULLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
         if CLLong
nread CLLong -> CLLong -> Bool
forall a. Ord a => a -> a -> Bool
< CLLong
0
            then
              Ptr C'zip_file -> IO ZipError
get_file_error Ptr C'zip_file
zf IO ZipError -> (ZipError -> IO [a]) -> IO [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO [a]
forall e a. Exception e => e -> IO a
E.throwIO
            else do
              [Word8]
bs <- Int -> Ptr Word8 -> IO [Word8]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CLLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLLong
nread) Ptr Word8
buf :: IO [Word8]
              [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> IO [a]) -> ([Word8] -> [a]) -> [Word8] -> IO [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> a) -> [Word8] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (Word8 -> Int) -> Word8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum) ([Word8] -> IO [a]) -> [Word8] -> IO [a]
forall a b. (a -> b) -> a -> b
$ [Word8]
bs

-- | Skip @n@ bytes from the open file. Note: this is not faster than reading.
skipBytes :: Integer -> Entry ()
skipBytes :: Integer
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ()
skipBytes Integer
n = (Integer -> Entry [Word8]
forall a. Enum a => Integer -> Entry [a]
readBytes Integer
n :: Entry [Word8]) Entry [Word8]
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ()
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ()
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag]) (StateT (Ptr C'zip) IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Read entire file contents.
readContents ::
    (Enum a)
    => Entry [a]  -- ^ Contents of the file.
readContents :: Entry [a]
readContents = do
  (Ptr C'zip_file
_,Integer
i,[FileFlag]
flags) <- StateT
  (Ptr C'zip_file, Integer, [FileFlag])
  (StateT (Ptr C'zip) IO)
  (Ptr C'zip_file, Integer, [FileFlag])
forall s (m :: * -> *). MonadState s m => m s
get
  Integer
sz <- Archive Integer
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag])
     (StateT (Ptr C'zip) IO)
     Integer
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Archive Integer
 -> StateT
      (Ptr C'zip_file, Integer, [FileFlag])
      (StateT (Ptr C'zip) IO)
      Integer)
-> Archive Integer
-> StateT
     (Ptr C'zip_file, Integer, [FileFlag])
     (StateT (Ptr C'zip) IO)
     Integer
forall a b. (a -> b) -> a -> b
$ [FileFlag] -> Integer -> Archive Integer
fileSizeIx [FileFlag]
flags Integer
i
  Integer -> Entry [a]
forall a. Enum a => Integer -> Entry [a]
readBytes Integer
sz

-- | Read entire file. Shortcut for 'readContents' from within 'Archive' monad.
fileContents :: (Enum a)
    => [FileFlag]
    -> FilePath
    -> Archive [a]
fileContents :: [FileFlag] -> FilePath -> Archive [a]
fileContents [FileFlag]
flags FilePath
name = [FileFlag] -> FilePath -> Entry [a] -> Archive [a]
forall a. [FileFlag] -> FilePath -> Entry a -> Archive a
fromFile [FileFlag]
flags FilePath
name Entry [a]
forall a. Enum a => Entry [a]
readContents

-- | Read entire file (referenced by position index). Shortcut for
-- 'readContents' from within 'Archive' monad.
fileContentsIx :: (Enum a)
    => [FileFlag]
    -> Integer
    -> Archive [a]
fileContentsIx :: [FileFlag] -> Integer -> Archive [a]
fileContentsIx [FileFlag]
flags Integer
i = [FileFlag] -> Integer -> Entry [a] -> Archive [a]
forall a. [FileFlag] -> Integer -> Entry a -> Archive a
fromFileIx [FileFlag]
flags Integer
i Entry [a]
forall a. Enum a => Entry [a]
readContents

--
-- Helpers
--

-- | Get archive handler. Throw 'ErrINVAL' if the archive is closed.
getZip :: Archive Zip
getZip :: Archive (Ptr C'zip)
getZip = do
  Ptr C'zip
z <- Archive (Ptr C'zip)
forall s (m :: * -> *). MonadState s m => m s
get
  if Ptr C'zip
z Ptr C'zip -> Ptr C'zip -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr C'zip
forall a. Ptr a
nullPtr
     then IO (Ptr C'zip) -> Archive (Ptr C'zip)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Ptr C'zip) -> Archive (Ptr C'zip))
-> IO (Ptr C'zip) -> Archive (Ptr C'zip)
forall a b. (a -> b) -> a -> b
$ ZipError -> IO (Ptr C'zip)
forall e a. Exception e => e -> IO a
E.throwIO ZipError
ErrINVAL
     else Ptr C'zip -> Archive (Ptr C'zip)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr C'zip
z

-- | Get and throw a 'ZipError' if condition fails. Otherwise work normally.
doIf :: Bool -> Zip -> (Zip -> IO a) -> IO a
doIf :: Bool -> Ptr C'zip -> (Ptr C'zip -> IO a) -> IO a
doIf Bool
cnd Ptr C'zip
z Ptr C'zip -> IO a
action =
    if Bool
cnd
       then Ptr C'zip -> IO a
action Ptr C'zip
z
       else Ptr C'zip -> IO ZipError
get_error Ptr C'zip
z IO ZipError -> (ZipError -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ZipError -> IO a
forall e a. Exception e => e -> IO a
E.throwIO

-- | Get and throw a 'ZipError' if condition fails. See also 'doIf'.
doIf' :: Bool -> Zip -> (IO a) -> IO a
doIf' :: Bool -> Ptr C'zip -> IO a -> IO a
doIf' Bool
cnd Ptr C'zip
z IO a
action = Bool -> Ptr C'zip -> (Ptr C'zip -> IO a) -> IO a
forall a. Bool -> Ptr C'zip -> (Ptr C'zip -> IO a) -> IO a
doIf Bool
cnd Ptr C'zip
z (IO a -> Ptr C'zip -> IO a
forall a b. a -> b -> a
const IO a
action)