{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      :  Codec.Archive.Zip
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- The module provides everything you may need to manipulate Zip archives.
-- There are three things that should be clarified right away, to avoid
-- confusion.
--
-- First, we use the 'EntrySelector' type that can be obtained from relative
-- 'FilePath's (paths to directories are not allowed). This method may seem
-- awkward at first, but it will protect you from the problems with
-- portability when your archive is unpacked on a different platform.
--
-- Second, there is no way to add directories, or to be precise, /empty
-- directories/ to your archive. This approach is used in Git, and I find it
-- sane.
--
-- Finally, the third feature of the library is that it does not modify
-- archive instantly, because doing so on every manipulation would often be
-- inefficient. Instead, we maintain a collection of pending actions that
-- can be turned into an optimized procedure that efficiently modifies the
-- archive in one pass. Normally, this should be of no concern to you,
-- because all actions are performed automatically when you leave the
-- 'ZipArchive' monad. If, however, you ever need to force an update, the
-- 'commit' function is your friend.
--
-- === Examples
--
-- An example of a program that prints a list of archive entries:
--
-- > import Codec.Archive.Zip
-- > import System.Environment (getArgs)
-- > import qualified Data.Map as M
-- >
-- > main :: IO ()
-- > main = do
-- >   [path]  <- getArgs
-- >   entries <- withArchive path (M.keys <$> getEntries)
-- >   mapM_ print entries
--
-- Create a Zip archive with a “Hello World” file:
--
-- > import Codec.Archive.Zip
-- > import System.Environment (getArgs)
-- >
-- > main :: IO ()
-- > main = do
-- >   [path] <- getArgs
-- >   s      <- mkEntrySelector "hello-world.txt"
-- >   createArchive path (addEntry Store "Hello, World!" s)
--
-- Extract contents of a file and print them:
--
-- > import Codec.Archive.Zip
-- > import System.Environment (getArgs)
-- > import qualified Data.ByteString.Char8 as B
-- >
-- > main :: IO ()
-- > main = do
-- >   [path,f] <- getArgs
-- >   s        <- mkEntrySelector f
-- >   bs       <- withArchive path (getEntry s)
-- >   B.putStrLn bs
module Codec.Archive.Zip
  ( -- * Types

    -- ** Entry selector
    EntrySelector,
    mkEntrySelector,
    unEntrySelector,
    getEntryName,
    EntrySelectorException (..),

    -- ** Entry description
    EntryDescription (..),
    CompressionMethod (..),

    -- ** Archive description
    ArchiveDescription (..),

    -- ** Exceptions
    ZipException (..),

    -- * Archive monad
    ZipArchive,
    ZipState,
    createArchive,
    withArchive,

    -- * Retrieving information
    getEntries,
    doesEntryExist,
    getEntryDesc,
    getEntry,
    getEntrySource,
    sourceEntry,
    saveEntry,
    checkEntry,
    unpackInto,
    getArchiveComment,
    getArchiveDescription,

    -- * Modifying archive

    -- ** Adding entries
    addEntry,
    sinkEntry,
    loadEntry,
    copyEntry,
    packDirRecur,
    packDirRecur',

    -- ** Modifying entries
    renameEntry,
    deleteEntry,
    recompress,
    setEntryComment,
    deleteEntryComment,
    setModTime,
    addExtraField,
    deleteExtraField,
    setExternalFileAttrs,
    forEntries,

    -- ** Operations on archive as a whole
    setArchiveComment,
    deleteArchiveComment,

    -- ** Control over editing
    undoEntryChanges,
    undoArchiveChanges,
    undoAll,
    commit,
  )
where

import Codec.Archive.Zip.Internal qualified as I
import Codec.Archive.Zip.Internal.Type
import Conduit (PrimMonad)
import Control.Monad
import Control.Monad.Base (MonadBase (..))
import Control.Monad.Catch
import Control.Monad.State.Strict
import Control.Monad.Trans.Control (MonadBaseControl (..))
import Control.Monad.Trans.Resource (MonadResource, ResourceT)
import Data.ByteString (ByteString)
import Data.Conduit (ConduitT, (.|))
import Data.Conduit qualified as C
import Data.Conduit.Binary qualified as CB
import Data.Conduit.List qualified as CL
import Data.DList qualified as DList
import Data.Map.Strict (Map, (!))
import Data.Map.Strict qualified as M
import Data.Sequence (Seq, (|>))
import Data.Sequence qualified as S
import Data.Set qualified as E
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Void
import Data.Word (Word16, Word32)
import System.Directory
import System.FilePath ((</>))
import System.FilePath qualified as FP
import System.IO.Error (isDoesNotExistError)

#ifndef mingw32_HOST_OS
import qualified Codec.Archive.Zip.Unix as Unix
import qualified System.Posix as Unix
#endif

----------------------------------------------------------------------------
-- Archive monad

-- | Monad that provides context necessary for performing operations on zip
-- archives. It's intentionally opaque and not a monad transformer to limit
-- the actions that can be performed in it to those provided by this module
-- and their combinations.
newtype ZipArchive a = ZipArchive
  { forall a. ZipArchive a -> StateT ZipState IO a
unZipArchive :: StateT ZipState IO a
  }
  deriving
    ( (forall a b. (a -> b) -> ZipArchive a -> ZipArchive b)
-> (forall a b. a -> ZipArchive b -> ZipArchive a)
-> Functor ZipArchive
forall a b. a -> ZipArchive b -> ZipArchive a
forall a b. (a -> b) -> ZipArchive a -> ZipArchive b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ZipArchive a -> ZipArchive b
fmap :: forall a b. (a -> b) -> ZipArchive a -> ZipArchive b
$c<$ :: forall a b. a -> ZipArchive b -> ZipArchive a
<$ :: forall a b. a -> ZipArchive b -> ZipArchive a
Functor,
      Functor ZipArchive
Functor ZipArchive =>
(forall a. a -> ZipArchive a)
-> (forall a b.
    ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b)
-> (forall a b c.
    (a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c)
-> (forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b)
-> (forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a)
-> Applicative ZipArchive
forall a. a -> ZipArchive a
forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a
forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
forall a b. ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b
forall a b c.
(a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ZipArchive a
pure :: forall a. a -> ZipArchive a
$c<*> :: forall a b. ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b
<*> :: forall a b. ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b
$cliftA2 :: forall a b c.
(a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c
liftA2 :: forall a b c.
(a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c
$c*> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
*> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
$c<* :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a
<* :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a
Applicative,
      Applicative ZipArchive
Applicative ZipArchive =>
(forall a b. ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b)
-> (forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b)
-> (forall a. a -> ZipArchive a)
-> Monad ZipArchive
forall a. a -> ZipArchive a
forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
forall a b. ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
>>= :: forall a b. ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
$c>> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
>> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
$creturn :: forall a. a -> ZipArchive a
return :: forall a. a -> ZipArchive a
Monad,
      Monad ZipArchive
Monad ZipArchive =>
(forall a. IO a -> ZipArchive a) -> MonadIO ZipArchive
forall a. IO a -> ZipArchive a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> ZipArchive a
liftIO :: forall a. IO a -> ZipArchive a
MonadIO,
      Monad ZipArchive
Monad ZipArchive =>
(forall e a. (HasCallStack, Exception e) => e -> ZipArchive a)
-> MonadThrow ZipArchive
forall e a. (HasCallStack, Exception e) => e -> ZipArchive a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall e a. (HasCallStack, Exception e) => e -> ZipArchive a
throwM :: forall e a. (HasCallStack, Exception e) => e -> ZipArchive a
MonadThrow,
      MonadThrow ZipArchive
MonadThrow ZipArchive =>
(forall e a.
 (HasCallStack, Exception e) =>
 ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a)
-> MonadCatch ZipArchive
forall e a.
(HasCallStack, Exception e) =>
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall e a.
(HasCallStack, Exception e) =>
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
catch :: forall e a.
(HasCallStack, Exception e) =>
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
MonadCatch,
      MonadCatch ZipArchive
MonadCatch ZipArchive =>
(forall b.
 HasCallStack =>
 ((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
 -> ZipArchive b)
-> (forall b.
    HasCallStack =>
    ((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
    -> ZipArchive b)
-> (forall a b c.
    HasCallStack =>
    ZipArchive a
    -> (a -> ExitCase b -> ZipArchive c)
    -> (a -> ZipArchive b)
    -> ZipArchive (b, c))
-> MonadMask ZipArchive
forall b.
HasCallStack =>
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
forall a b c.
HasCallStack =>
ZipArchive a
-> (a -> ExitCase b -> ZipArchive c)
-> (a -> ZipArchive b)
-> ZipArchive (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall b.
HasCallStack =>
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
mask :: forall b.
HasCallStack =>
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
$cuninterruptibleMask :: forall b.
HasCallStack =>
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
$cgeneralBracket :: forall a b c.
HasCallStack =>
ZipArchive a
-> (a -> ExitCase b -> ZipArchive c)
-> (a -> ZipArchive b)
-> ZipArchive (b, c)
generalBracket :: forall a b c.
HasCallStack =>
ZipArchive a
-> (a -> ExitCase b -> ZipArchive c)
-> (a -> ZipArchive b)
-> ZipArchive (b, c)
MonadMask
    )

-- | @since 0.2.0
instance MonadBase IO ZipArchive where
  liftBase :: forall a. IO a -> ZipArchive a
liftBase = IO α -> ZipArchive α
forall a. IO a -> ZipArchive a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | @since 0.2.0
instance MonadBaseControl IO ZipArchive where
  type StM ZipArchive a = (a, ZipState)
  liftBaseWith :: forall a. (RunInBase ZipArchive IO -> IO a) -> ZipArchive a
liftBaseWith RunInBase ZipArchive IO -> IO a
f = StateT ZipState IO a -> ZipArchive a
forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive (StateT ZipState IO a -> ZipArchive a)
-> ((ZipState -> IO (a, ZipState)) -> StateT ZipState IO a)
-> (ZipState -> IO (a, ZipState))
-> ZipArchive a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZipState -> IO (a, ZipState)) -> StateT ZipState IO a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((ZipState -> IO (a, ZipState)) -> ZipArchive a)
-> (ZipState -> IO (a, ZipState)) -> ZipArchive a
forall a b. (a -> b) -> a -> b
$ \ZipState
s ->
    (,ZipState
s) (a -> (a, ZipState)) -> IO a -> IO (a, ZipState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunInBase ZipArchive IO -> IO a
f ((StateT ZipState IO a -> ZipState -> IO (a, ZipState))
-> ZipState -> StateT ZipState IO a -> IO (a, ZipState)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT ZipState IO a -> ZipState -> IO (a, ZipState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ZipState
s (StateT ZipState IO a -> IO (a, ZipState))
-> (ZipArchive a -> StateT ZipState IO a)
-> ZipArchive a
-> IO (a, ZipState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipArchive a -> StateT ZipState IO a
forall a. ZipArchive a -> StateT ZipState IO a
unZipArchive)
  {-# INLINEABLE liftBaseWith #-}
  restoreM :: forall a. StM ZipArchive a -> ZipArchive a
restoreM = StateT ZipState IO a -> ZipArchive a
forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive (StateT ZipState IO a -> ZipArchive a)
-> ((a, ZipState) -> StateT ZipState IO a)
-> (a, ZipState)
-> ZipArchive a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZipState -> IO (a, ZipState)) -> StateT ZipState IO a
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((ZipState -> IO (a, ZipState)) -> StateT ZipState IO a)
-> ((a, ZipState) -> ZipState -> IO (a, ZipState))
-> (a, ZipState)
-> StateT ZipState IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (a, ZipState) -> ZipState -> IO (a, ZipState)
forall a b. a -> b -> a
const (IO (a, ZipState) -> ZipState -> IO (a, ZipState))
-> ((a, ZipState) -> IO (a, ZipState))
-> (a, ZipState)
-> ZipState
-> IO (a, ZipState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, ZipState) -> IO (a, ZipState)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
  {-# INLINEABLE restoreM #-}

-- | The internal state record used by the 'ZipArchive' monad. This is only
-- exported for use with 'MonadBaseControl' methods, you can't look inside.
--
-- @since 0.2.0
data ZipState = ZipState
  { -- | Path to zip archive
    ZipState -> FilePath
zsFilePath :: FilePath,
    -- | Actual collection of entries
    ZipState -> Map EntrySelector EntryDescription
zsEntries :: Map EntrySelector EntryDescription,
    -- | Info about the whole archive
    ZipState -> ArchiveDescription
zsArchive :: ArchiveDescription,
    -- | Pending actions
    ZipState -> Seq PendingAction
zsActions :: Seq I.PendingAction
  }

-- | Create a new archive given its location and an action that describes
-- how to create contents of the archive. This will silently overwrite the
-- specified file if it already exists. See 'withArchive' if you want to
-- work with an existing archive.
createArchive ::
  (MonadIO m) =>
  -- | Location of the archive file to create
  FilePath ->
  -- | Actions that create the archive's content
  ZipArchive a ->
  m a
createArchive :: forall (m :: * -> *) a.
MonadIO m =>
FilePath -> ZipArchive a -> m a
createArchive FilePath
path ZipArchive a
m = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
  apath <- FilePath -> IO FilePath
makeAbsolute FilePath
path
  ignoringAbsence (removeFile apath)
  let st =
        ZipState
          { zsFilePath :: FilePath
zsFilePath = FilePath
apath,
            zsEntries :: Map EntrySelector EntryDescription
zsEntries = Map EntrySelector EntryDescription
forall k a. Map k a
M.empty,
            zsArchive :: ArchiveDescription
zsArchive = Maybe Text -> Natural -> Natural -> ArchiveDescription
ArchiveDescription Maybe Text
forall a. Maybe a
Nothing Natural
0 Natural
0,
            zsActions :: Seq PendingAction
zsActions = Seq PendingAction
forall a. Seq a
S.empty
          }
      action = ZipArchive a -> StateT ZipState IO a
forall a. ZipArchive a -> StateT ZipState IO a
unZipArchive (ZipArchive a
m ZipArchive a -> ZipArchive () -> ZipArchive a
forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ZipArchive ()
commit)
  evalStateT action st

-- | Work with an existing archive. See 'createArchive' if you want to
-- create a new archive instead.
--
-- This operation may fail with:
--
--     * @isAlreadyInUseError@ if the file is already open and cannot be
--     reopened;
--
--     * @isDoesNotExistError@ if the file does not exist;
--
--     * @isPermissionError@ if the user does not have permission to open
--     the file;
--
--     * 'ParsingFailed' when specified archive is something this library
--     cannot parse (this includes multi-disk archives, for example).
--
-- Please note that entries with invalid (non-portable) file names may be
-- missing in the list of entries. Files that are compressed with
-- unsupported compression methods are skipped as well. Also, if several
-- entries would collide on some operating systems (such as Windows, because
-- of its case-insensitivity), only one of them will be available, because
-- 'EntrySelector' is case-insensitive. These are the consequences of the
-- design decision to make it impossible to create non-portable archives
-- with this library.
withArchive ::
  (MonadIO m) =>
  -- | Location of the archive to work with
  FilePath ->
  -- | Actions on that archive
  ZipArchive a ->
  m a
withArchive :: forall (m :: * -> *) a.
MonadIO m =>
FilePath -> ZipArchive a -> m a
withArchive FilePath
path ZipArchive a
m = IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
  apath <- FilePath -> IO FilePath
canonicalizePath FilePath
path
  (desc, entries) <- liftIO (I.scanArchive apath)
  let st =
        ZipState
          { zsFilePath :: FilePath
zsFilePath = FilePath
apath,
            zsEntries :: Map EntrySelector EntryDescription
zsEntries = Map EntrySelector EntryDescription
entries,
            zsArchive :: ArchiveDescription
zsArchive = ArchiveDescription
desc,
            zsActions :: Seq PendingAction
zsActions = Seq PendingAction
forall a. Seq a
S.empty
          }
      action = ZipArchive a -> StateT ZipState IO a
forall a. ZipArchive a -> StateT ZipState IO a
unZipArchive (ZipArchive a
m ZipArchive a -> ZipArchive () -> ZipArchive a
forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ZipArchive ()
commit)
  liftIO (evalStateT action st)

----------------------------------------------------------------------------
-- Retrieving information

-- | Retrieve a description of all archive entries. This is an efficient
-- operation that can be used for example to list all entries in the
-- archive. Do not hesitate to use the function frequently: scanning of the
-- archive happens only once.
--
-- Please note that the returned value only reflects the current contents of
-- the archive in file system, non-committed actions are not reflected, see
-- 'commit' for more information.
getEntries :: ZipArchive (Map EntrySelector EntryDescription)
getEntries :: ZipArchive (Map EntrySelector EntryDescription)
getEntries = StateT ZipState IO (Map EntrySelector EntryDescription)
-> ZipArchive (Map EntrySelector EntryDescription)
forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive ((ZipState -> Map EntrySelector EntryDescription)
-> StateT ZipState IO (Map EntrySelector EntryDescription)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ZipState -> Map EntrySelector EntryDescription
zsEntries)

-- | Check whether the specified entry exists in the archive. This is a
-- simple shortcut defined as:
--
-- > doesEntryExist s = M.member s <$> getEntries
doesEntryExist :: EntrySelector -> ZipArchive Bool
doesEntryExist :: EntrySelector -> ZipArchive Bool
doesEntryExist EntrySelector
s = EntrySelector -> Map EntrySelector EntryDescription -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member EntrySelector
s (Map EntrySelector EntryDescription -> Bool)
-> ZipArchive (Map EntrySelector EntryDescription)
-> ZipArchive Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipArchive (Map EntrySelector EntryDescription)
getEntries

-- | Get 'EntryDescription' for a specified entry. This is a simple shortcut
-- defined as:
--
-- > getEntryDesc s = M.lookup s <$> getEntries
getEntryDesc :: EntrySelector -> ZipArchive (Maybe EntryDescription)
getEntryDesc :: EntrySelector -> ZipArchive (Maybe EntryDescription)
getEntryDesc EntrySelector
s = EntrySelector
-> Map EntrySelector EntryDescription -> Maybe EntryDescription
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup EntrySelector
s (Map EntrySelector EntryDescription -> Maybe EntryDescription)
-> ZipArchive (Map EntrySelector EntryDescription)
-> ZipArchive (Maybe EntryDescription)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipArchive (Map EntrySelector EntryDescription)
getEntries

-- | Get contents of a specific archive entry as a strict 'ByteString'. It's
-- not recommended to use this on big entries, because it will suck out a
-- lot of memory. For big entries, use conduits: 'sourceEntry'.
--
-- Throws: 'EntryDoesNotExist'.
getEntry ::
  -- | Selector that identifies archive entry
  EntrySelector ->
  -- | Contents of the entry
  ZipArchive ByteString
getEntry :: EntrySelector -> ZipArchive ByteString
getEntry EntrySelector
s = EntrySelector
-> ConduitT ByteString Void (ResourceT IO) ByteString
-> ZipArchive ByteString
forall a.
EntrySelector
-> ConduitT ByteString Void (ResourceT IO) a -> ZipArchive a
sourceEntry EntrySelector
s ((ByteString -> ByteString)
-> ConduitT ByteString Void (ResourceT IO) ByteString
forall (m :: * -> *) b a o.
(Monad m, Monoid b) =>
(a -> b) -> ConduitT a o m b
CL.foldMap ByteString -> ByteString
forall a. a -> a
id)

-- | Get an entry source.
--
-- Throws: 'EntryDoesNotExist'.
--
-- @since 0.1.3
getEntrySource ::
  (PrimMonad m, MonadThrow m, MonadResource m) =>
  -- | Selector that identifies archive entry
  EntrySelector ->
  ZipArchive (ConduitT () ByteString m ())
getEntrySource :: forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
EntrySelector -> ZipArchive (ConduitT () ByteString m ())
getEntrySource EntrySelector
s = do
  path <- ZipArchive FilePath
getFilePath
  mdesc <- M.lookup s <$> getEntries
  case mdesc of
    Maybe EntryDescription
Nothing -> ZipException -> ZipArchive (ConduitT () ByteString m ())
forall e a. (HasCallStack, Exception e) => e -> ZipArchive a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (FilePath -> EntrySelector -> ZipException
EntryDoesNotExist FilePath
path EntrySelector
s)
    Just EntryDescription
desc -> ConduitT () ByteString m ()
-> ZipArchive (ConduitT () ByteString m ())
forall a. a -> ZipArchive a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> EntryDescription -> Bool -> ConduitT () ByteString m ()
forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
FilePath -> EntryDescription -> Bool -> ConduitT () ByteString m ()
I.sourceEntry FilePath
path EntryDescription
desc Bool
True)

-- | Stream contents of an archive entry to the given 'Sink'.
--
-- Throws: 'EntryDoesNotExist'.
sourceEntry ::
  -- | Selector that identifies the archive entry
  EntrySelector ->
  -- | Sink where to stream entry contents
  ConduitT ByteString Void (ResourceT IO) a ->
  -- | Contents of the entry (if found)
  ZipArchive a
sourceEntry :: forall a.
EntrySelector
-> ConduitT ByteString Void (ResourceT IO) a -> ZipArchive a
sourceEntry EntrySelector
s ConduitT ByteString Void (ResourceT IO) a
sink = do
  src <- EntrySelector
-> ZipArchive (ConduitT () ByteString (ResourceT IO) ())
forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
EntrySelector -> ZipArchive (ConduitT () ByteString m ())
getEntrySource EntrySelector
s
  (liftIO . C.runConduitRes) (src .| sink)

-- | Save a specific archive entry as a file in the file system.
--
-- Throws: 'EntryDoesNotExist'.
saveEntry ::
  -- | Selector that identifies the archive entry
  EntrySelector ->
  -- | Where to save the file
  FilePath ->
  ZipArchive ()
saveEntry :: EntrySelector -> FilePath -> ZipArchive ()
saveEntry EntrySelector
s FilePath
path = do
  EntrySelector
-> ConduitT ByteString Void (ResourceT IO) () -> ZipArchive ()
forall a.
EntrySelector
-> ConduitT ByteString Void (ResourceT IO) a -> ZipArchive a
sourceEntry EntrySelector
s (FilePath -> ConduitT ByteString Void (ResourceT IO) ()
forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
CB.sinkFile FilePath
path)
  med <- EntrySelector -> ZipArchive (Maybe EntryDescription)
getEntryDesc EntrySelector
s
  forM_ med (liftIO . setModificationTime path . edModTime)

-- | Calculate CRC32 check sum and compare it with the value read from the
-- archive. The function returns 'True' when the check sums are the
-- same—that is, the data is not corrupted.
--
-- Throws: 'EntryDoesNotExist'.
checkEntry ::
  -- | Selector that identifies the archive entry
  EntrySelector ->
  -- | Is the entry intact?
  ZipArchive Bool
checkEntry :: EntrySelector -> ZipArchive Bool
checkEntry EntrySelector
s = do
  calculated <- EntrySelector
-> ConduitT ByteString Void (ResourceT IO) Word32
-> ZipArchive Word32
forall a.
EntrySelector
-> ConduitT ByteString Void (ResourceT IO) a -> ZipArchive a
sourceEntry EntrySelector
s ConduitT ByteString Void (ResourceT IO) Word32
I.crc32Sink
  given <- edCRC32 . (! s) <$> getEntries
  -- NOTE We can assume that entry exists for sure because otherwise
  -- 'sourceEntry' would have thrown 'EntryDoesNotExist' already.
  return (calculated == given)

-- | Unpack the archive into the specified directory. The directory will be
-- created if it does not exist.
unpackInto :: FilePath -> ZipArchive ()
unpackInto :: FilePath -> ZipArchive ()
unpackInto FilePath
dir' = do
  selectors <- Map EntrySelector EntryDescription -> Set EntrySelector
forall k a. Map k a -> Set k
M.keysSet (Map EntrySelector EntryDescription -> Set EntrySelector)
-> ZipArchive (Map EntrySelector EntryDescription)
-> ZipArchive (Set EntrySelector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipArchive (Map EntrySelector EntryDescription)
getEntries
  unless (null selectors) $ do
    dir <- liftIO (makeAbsolute dir')
    liftIO (createDirectoryIfMissing True dir)
    let dirs = (EntrySelector -> FilePath) -> Set EntrySelector -> Set FilePath
forall b a. Ord b => (a -> b) -> Set a -> Set b
E.map (FilePath -> FilePath
FP.takeDirectory (FilePath -> FilePath)
-> (EntrySelector -> FilePath) -> EntrySelector -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
dir FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath)
-> (EntrySelector -> FilePath) -> EntrySelector -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntrySelector -> FilePath
unEntrySelector) Set EntrySelector
selectors
    forM_ dirs (liftIO . createDirectoryIfMissing True)
    forM_ selectors $ \EntrySelector
s ->
      EntrySelector -> FilePath -> ZipArchive ()
saveEntry EntrySelector
s (FilePath
dir FilePath -> FilePath -> FilePath
</> EntrySelector -> FilePath
unEntrySelector EntrySelector
s)

-- | Get the archive comment.
getArchiveComment :: ZipArchive (Maybe Text)
getArchiveComment :: ZipArchive (Maybe Text)
getArchiveComment = ArchiveDescription -> Maybe Text
adComment (ArchiveDescription -> Maybe Text)
-> ZipArchive ArchiveDescription -> ZipArchive (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipArchive ArchiveDescription
getArchiveDescription

-- | Get the archive description record.
getArchiveDescription :: ZipArchive ArchiveDescription
getArchiveDescription :: ZipArchive ArchiveDescription
getArchiveDescription = StateT ZipState IO ArchiveDescription
-> ZipArchive ArchiveDescription
forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive ((ZipState -> ArchiveDescription)
-> StateT ZipState IO ArchiveDescription
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ZipState -> ArchiveDescription
zsArchive)

----------------------------------------------------------------------------
-- Modifying archive

-- | Add a new entry to the archive given its contents in binary form.
addEntry ::
  -- | The compression method to use
  CompressionMethod ->
  -- | Entry contents
  ByteString ->
  -- | Name of the entry to add
  EntrySelector ->
  ZipArchive ()
addEntry :: CompressionMethod -> ByteString -> EntrySelector -> ZipArchive ()
addEntry CompressionMethod
t ByteString
b EntrySelector
s = PendingAction -> ZipArchive ()
addPending (CompressionMethod -> ByteString -> EntrySelector -> PendingAction
I.StrictEntry CompressionMethod
t ByteString
b EntrySelector
s)

-- | Stream data from the specified source to an archive entry.
sinkEntry ::
  -- | The compression method to use
  CompressionMethod ->
  -- | Source of entry contents
  ConduitT () ByteString (ResourceT IO) () ->
  -- | Name of the entry to add
  EntrySelector ->
  ZipArchive ()
sinkEntry :: CompressionMethod
-> ConduitT () ByteString (ResourceT IO) ()
-> EntrySelector
-> ZipArchive ()
sinkEntry CompressionMethod
t ConduitT () ByteString (ResourceT IO) ()
src EntrySelector
s = PendingAction -> ZipArchive ()
addPending (CompressionMethod
-> ConduitT () ByteString (ResourceT IO) ()
-> EntrySelector
-> PendingAction
I.SinkEntry CompressionMethod
t ConduitT () ByteString (ResourceT IO) ()
src EntrySelector
s)

-- | Load an entry from a given file.
loadEntry ::
  -- | The compression method to use
  CompressionMethod ->
  -- | Name of the entry to add
  EntrySelector ->
  -- | Path to the file to add
  FilePath ->
  ZipArchive ()
loadEntry :: CompressionMethod -> EntrySelector -> FilePath -> ZipArchive ()
loadEntry CompressionMethod
t EntrySelector
s FilePath
path = do
  apath <- IO FilePath -> ZipArchive FilePath
forall a. IO a -> ZipArchive a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
canonicalizePath FilePath
path)
  modTime <- liftIO (getModificationTime path)
  let src = FilePath -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
CB.sourceFile FilePath
apath
  addPending (I.SinkEntry t src s)
  addPending (I.SetModTime modTime s)

#ifndef mingw32_HOST_OS
  status <- liftIO $ Unix.getFileStatus path
  setExternalFileAttrs (Unix.fromFileMode (Unix.fileMode status)) s
#endif

-- | Copy an entry “as is” from another zip archive. If the entry does not
-- exist in that archive, 'EntryDoesNotExist' will be thrown.
copyEntry ::
  -- | Path to the archive to copy from
  FilePath ->
  -- | Name of the entry (in the source archive) to copy
  EntrySelector ->
  -- | Name of the entry to insert (in current archive)
  EntrySelector ->
  ZipArchive ()
copyEntry :: FilePath -> EntrySelector -> EntrySelector -> ZipArchive ()
copyEntry FilePath
path EntrySelector
s' EntrySelector
s = do
  apath <- IO FilePath -> ZipArchive FilePath
forall a. IO a -> ZipArchive a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
canonicalizePath FilePath
path)
  addPending (I.CopyEntry apath s' s)

-- | Add an directory to the archive. Please note that due to the design of
-- the library, empty sub-directories will not be added.
--
-- The action can throw 'InvalidEntrySelector'.
packDirRecur ::
  -- | The compression method to use
  CompressionMethod ->
  -- | How to get the 'EntrySelector' from a path relative to the root of
  -- the directory we pack
  (FilePath -> ZipArchive EntrySelector) ->
  -- | Path to the directory to add
  FilePath ->
  ZipArchive ()
packDirRecur :: CompressionMethod
-> (FilePath -> ZipArchive EntrySelector)
-> FilePath
-> ZipArchive ()
packDirRecur CompressionMethod
t FilePath -> ZipArchive EntrySelector
f = CompressionMethod
-> (FilePath -> ZipArchive EntrySelector)
-> (EntrySelector -> ZipArchive ())
-> FilePath
-> ZipArchive ()
packDirRecur' CompressionMethod
t FilePath -> ZipArchive EntrySelector
f (ZipArchive () -> EntrySelector -> ZipArchive ()
forall a b. a -> b -> a
const (ZipArchive () -> EntrySelector -> ZipArchive ())
-> ZipArchive () -> EntrySelector -> ZipArchive ()
forall a b. (a -> b) -> a -> b
$ () -> ZipArchive ()
forall a. a -> ZipArchive a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | The same as 'packDirRecur' but allows us to perform modifying actions
-- on the created entities as we go.
--
-- @since 1.5.0
packDirRecur' ::
  -- | The compression method to use
  CompressionMethod ->
  -- | How to get the 'EntrySelector' from a path relative to the root of
  -- the directory we pack
  (FilePath -> ZipArchive EntrySelector) ->
  -- | How to modify an entry after creation
  (EntrySelector -> ZipArchive ()) ->
  -- | Path to the directory to add
  FilePath ->
  ZipArchive ()
packDirRecur' :: CompressionMethod
-> (FilePath -> ZipArchive EntrySelector)
-> (EntrySelector -> ZipArchive ())
-> FilePath
-> ZipArchive ()
packDirRecur' CompressionMethod
t FilePath -> ZipArchive EntrySelector
f EntrySelector -> ZipArchive ()
patch FilePath
path = do
  files <- IO [FilePath] -> ZipArchive [FilePath]
forall a. IO a -> ZipArchive a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
listDirRecur FilePath
path)
  forM_ files $ \FilePath
x -> do
    s <- FilePath -> ZipArchive EntrySelector
f FilePath
x
    loadEntry t s (path </> x)
    patch s

-- | Rename an entry in the archive. If the entry does not exist, nothing
-- will happen.
renameEntry ::
  -- | The original entry name
  EntrySelector ->
  -- | The new entry name
  EntrySelector ->
  ZipArchive ()
renameEntry :: EntrySelector -> EntrySelector -> ZipArchive ()
renameEntry EntrySelector
old EntrySelector
new = PendingAction -> ZipArchive ()
addPending (EntrySelector -> EntrySelector -> PendingAction
I.RenameEntry EntrySelector
old EntrySelector
new)

-- | Delete an entry from the archive, if it does not exist, nothing will
-- happen.
deleteEntry :: EntrySelector -> ZipArchive ()
deleteEntry :: EntrySelector -> ZipArchive ()
deleteEntry EntrySelector
s = PendingAction -> ZipArchive ()
addPending (EntrySelector -> PendingAction
I.DeleteEntry EntrySelector
s)

-- | Change compression method of an entry, if it does not exist, nothing
-- will happen.
recompress ::
  -- | The new compression method
  CompressionMethod ->
  -- | Name of the entry to re-compress
  EntrySelector ->
  ZipArchive ()
recompress :: CompressionMethod -> EntrySelector -> ZipArchive ()
recompress CompressionMethod
t EntrySelector
s = PendingAction -> ZipArchive ()
addPending (CompressionMethod -> EntrySelector -> PendingAction
I.Recompress CompressionMethod
t EntrySelector
s)

-- | Set an entry comment, if that entry does not exist, nothing will
-- happen. Note that if binary representation of the comment is longer than
-- 65535 bytes, it will be truncated on writing.
setEntryComment ::
  -- | Text of the comment
  Text ->
  -- | Name of the entry to comment on
  EntrySelector ->
  ZipArchive ()
setEntryComment :: Text -> EntrySelector -> ZipArchive ()
setEntryComment Text
text EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Text -> EntrySelector -> PendingAction
I.SetEntryComment Text
text EntrySelector
s)

-- | Delete an entry's comment, if that entry does not exist, nothing will
-- happen.
deleteEntryComment :: EntrySelector -> ZipArchive ()
deleteEntryComment :: EntrySelector -> ZipArchive ()
deleteEntryComment EntrySelector
s = PendingAction -> ZipArchive ()
addPending (EntrySelector -> PendingAction
I.DeleteEntryComment EntrySelector
s)

-- | Set the last modification date\/time. The specified entry may be
-- missing, in that case the action has no effect.
setModTime ::
  -- | New modification time
  UTCTime ->
  -- | Name of the entry to modify
  EntrySelector ->
  ZipArchive ()
setModTime :: UTCTime -> EntrySelector -> ZipArchive ()
setModTime UTCTime
time EntrySelector
s = PendingAction -> ZipArchive ()
addPending (UTCTime -> EntrySelector -> PendingAction
I.SetModTime UTCTime
time EntrySelector
s)

-- | Add an extra field. The specified entry may be missing, in that case
-- this action has no effect.
addExtraField ::
  -- | Tag (header id) of the extra field to add
  Word16 ->
  -- | Body of the field
  ByteString ->
  -- | Name of the entry to modify
  EntrySelector ->
  ZipArchive ()
addExtraField :: Word16 -> ByteString -> EntrySelector -> ZipArchive ()
addExtraField Word16
n ByteString
b EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Word16 -> ByteString -> EntrySelector -> PendingAction
I.AddExtraField Word16
n ByteString
b EntrySelector
s)

-- | Delete an extra field by its type (tag). The specified entry may be
-- missing, in that case this action has no effect.
deleteExtraField ::
  -- | Tag (header id) of the extra field to delete
  Word16 ->
  -- | Name of the entry to modify
  EntrySelector ->
  ZipArchive ()
deleteExtraField :: Word16 -> EntrySelector -> ZipArchive ()
deleteExtraField Word16
n EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Word16 -> EntrySelector -> PendingAction
I.DeleteExtraField Word16
n EntrySelector
s)

-- | Set external file attributes. This function can be used to set file
-- permissions.
--
-- See also: "Codec.Archive.Zip.Unix".
--
-- @since 1.2.0
setExternalFileAttrs ::
  -- | External file attributes
  Word32 ->
  -- | Name of the entry to modify
  EntrySelector ->
  ZipArchive ()
setExternalFileAttrs :: Word32 -> EntrySelector -> ZipArchive ()
setExternalFileAttrs Word32
attrs EntrySelector
s =
  PendingAction -> ZipArchive ()
addPending (Word32 -> EntrySelector -> PendingAction
I.SetExternalFileAttributes Word32
attrs EntrySelector
s)

-- | Perform an action on every entry in the archive.
forEntries ::
  -- | The action to perform
  (EntrySelector -> ZipArchive ()) ->
  ZipArchive ()
forEntries :: (EntrySelector -> ZipArchive ()) -> ZipArchive ()
forEntries EntrySelector -> ZipArchive ()
action = ZipArchive (Map EntrySelector EntryDescription)
getEntries ZipArchive (Map EntrySelector EntryDescription)
-> (Map EntrySelector EntryDescription -> ZipArchive ())
-> ZipArchive ()
forall a b. ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (EntrySelector -> ZipArchive ())
-> Set EntrySelector -> ZipArchive ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EntrySelector -> ZipArchive ()
action (Set EntrySelector -> ZipArchive ())
-> (Map EntrySelector EntryDescription -> Set EntrySelector)
-> Map EntrySelector EntryDescription
-> ZipArchive ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map EntrySelector EntryDescription -> Set EntrySelector
forall k a. Map k a -> Set k
M.keysSet

-- | Set the comment of the entire archive.
setArchiveComment :: Text -> ZipArchive ()
setArchiveComment :: Text -> ZipArchive ()
setArchiveComment Text
text = PendingAction -> ZipArchive ()
addPending (Text -> PendingAction
I.SetArchiveComment Text
text)

-- | Delete the archive's comment if it's present.
deleteArchiveComment :: ZipArchive ()
deleteArchiveComment :: ZipArchive ()
deleteArchiveComment = PendingAction -> ZipArchive ()
addPending PendingAction
I.DeleteArchiveComment

-- | Undo the changes to a specific archive entry.
undoEntryChanges :: EntrySelector -> ZipArchive ()
undoEntryChanges :: EntrySelector -> ZipArchive ()
undoEntryChanges EntrySelector
s = (Seq PendingAction -> Seq PendingAction) -> ZipArchive ()
modifyActions Seq PendingAction -> Seq PendingAction
f
  where
    f :: Seq PendingAction -> Seq PendingAction
f = (PendingAction -> Bool) -> Seq PendingAction -> Seq PendingAction
forall a. (a -> Bool) -> Seq a -> Seq a
S.filter ((Maybe EntrySelector -> Maybe EntrySelector -> Bool
forall a. Eq a => a -> a -> Bool
/= EntrySelector -> Maybe EntrySelector
forall a. a -> Maybe a
Just EntrySelector
s) (Maybe EntrySelector -> Bool)
-> (PendingAction -> Maybe EntrySelector) -> PendingAction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PendingAction -> Maybe EntrySelector
I.targetEntry)

-- | Undo the changes to the archive as a whole (archive's comment).
undoArchiveChanges :: ZipArchive ()
undoArchiveChanges :: ZipArchive ()
undoArchiveChanges = (Seq PendingAction -> Seq PendingAction) -> ZipArchive ()
modifyActions Seq PendingAction -> Seq PendingAction
f
  where
    f :: Seq PendingAction -> Seq PendingAction
f = (PendingAction -> Bool) -> Seq PendingAction -> Seq PendingAction
forall a. (a -> Bool) -> Seq a -> Seq a
S.filter ((Maybe EntrySelector -> Maybe EntrySelector -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe EntrySelector
forall a. Maybe a
Nothing) (Maybe EntrySelector -> Bool)
-> (PendingAction -> Maybe EntrySelector) -> PendingAction -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PendingAction -> Maybe EntrySelector
I.targetEntry)

-- | Undo all changes made in this editing session.
undoAll :: ZipArchive ()
undoAll :: ZipArchive ()
undoAll = (Seq PendingAction -> Seq PendingAction) -> ZipArchive ()
modifyActions (Seq PendingAction -> Seq PendingAction -> Seq PendingAction
forall a b. a -> b -> a
const Seq PendingAction
forall a. Seq a
S.empty)

-- | Archive contents are not modified instantly, but instead changes are
-- collected as “pending actions” that should be committed, in order to
-- efficiently modify the archive in one pass. The actions are committed
-- automatically when the program leaves the 'ZipArchive' monad (i.e. as
-- part of 'createArchive' or 'withArchive'), or can be forced explicitly
-- with the help of this function. Once committed, changes take place in the
-- file system and cannot be undone.
commit :: ZipArchive ()
commit :: ZipArchive ()
commit = do
  file <- ZipArchive FilePath
getFilePath
  odesc <- getArchiveDescription
  oentries <- getEntries
  actions <- getPending
  exists <- liftIO (doesFileExist file)
  unless (S.null actions && exists) $ do
    liftIO (I.commit file odesc oentries actions)
    -- NOTE The most robust way to update the internal description of the
    -- archive is to scan it again—manual manipulations with descriptions of
    -- entries are too error-prone. We also want to erase all pending
    -- actions because 'I.commit' executes them all by definition.
    (ndesc, nentries) <- liftIO (I.scanArchive file)
    ZipArchive . modify $ \ZipState
st ->
      ZipState
st
        { zsEntries = nentries,
          zsArchive = ndesc,
          zsActions = S.empty
        }

----------------------------------------------------------------------------
-- Helpers

-- | Get the path of the actual archive file from inside of 'ZipArchive'
-- monad.
getFilePath :: ZipArchive FilePath
getFilePath :: ZipArchive FilePath
getFilePath = StateT ZipState IO FilePath -> ZipArchive FilePath
forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive ((ZipState -> FilePath) -> StateT ZipState IO FilePath
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ZipState -> FilePath
zsFilePath)

-- | Get the collection of pending actions.
getPending :: ZipArchive (Seq I.PendingAction)
getPending :: ZipArchive (Seq PendingAction)
getPending = StateT ZipState IO (Seq PendingAction)
-> ZipArchive (Seq PendingAction)
forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive ((ZipState -> Seq PendingAction)
-> StateT ZipState IO (Seq PendingAction)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ZipState -> Seq PendingAction
zsActions)

-- | Modify the collection of pending actions.
modifyActions :: (Seq I.PendingAction -> Seq I.PendingAction) -> ZipArchive ()
modifyActions :: (Seq PendingAction -> Seq PendingAction) -> ZipArchive ()
modifyActions Seq PendingAction -> Seq PendingAction
f = StateT ZipState IO () -> ZipArchive ()
forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive ((ZipState -> ZipState) -> StateT ZipState IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ZipState -> ZipState
g)
  where
    g :: ZipState -> ZipState
g ZipState
st = ZipState
st {zsActions = f (zsActions st)}

-- | Add a new action to the list of pending actions.
addPending :: I.PendingAction -> ZipArchive ()
addPending :: PendingAction -> ZipArchive ()
addPending PendingAction
a = (Seq PendingAction -> Seq PendingAction) -> ZipArchive ()
modifyActions (Seq PendingAction -> PendingAction -> Seq PendingAction
forall a. Seq a -> a -> Seq a
|> PendingAction
a)

-- | Recursively list a directory. Do not return paths to empty directories.
listDirRecur :: FilePath -> IO [FilePath]
listDirRecur :: FilePath -> IO [FilePath]
listDirRecur FilePath
path = DList FilePath -> [FilePath]
forall a. DList a -> [a]
DList.toList (DList FilePath -> [FilePath])
-> IO (DList FilePath) -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (DList FilePath)
go FilePath
""
  where
    go :: FilePath -> IO (DList FilePath)
go FilePath
adir = do
      let cdir :: FilePath
cdir = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
adir
      raw <- FilePath -> IO [FilePath]
listDirectory FilePath
cdir
      fmap mconcat . forM raw $ \case
        FilePath
"" -> DList FilePath -> IO (DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
        FilePath
"." -> DList FilePath -> IO (DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
        FilePath
".." -> DList FilePath -> IO (DList FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
        FilePath
x -> do
          let fullx :: FilePath
fullx = FilePath
cdir FilePath -> FilePath -> FilePath
</> FilePath
x
              adir' :: FilePath
adir' = FilePath
adir FilePath -> FilePath -> FilePath
</> FilePath
x
          isFile <- FilePath -> IO Bool
doesFileExist FilePath
fullx
          isDir <- doesDirectoryExist fullx
          if isFile
            then return (DList.singleton adir')
            else
              if isDir
                then go adir'
                else return mempty

-- | Perform an action ignoring IO exceptions it may throw.
ignoringAbsence :: IO () -> IO ()
ignoringAbsence :: IO () -> IO ()
ignoringAbsence IO ()
io = (IOError -> Maybe IOError) -> IO () -> (IOError -> IO ()) -> IO ()
forall (m :: * -> *) e b a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> (b -> m a) -> m a
catchJust IOError -> Maybe IOError
select IO ()
io IOError -> IO ()
forall {b}. b -> IO ()
handler
  where
    select :: IOError -> Maybe IOError
select IOError
e = if IOError -> Bool
isDoesNotExistError IOError
e then IOError -> Maybe IOError
forall a. a -> Maybe a
Just IOError
e else Maybe IOError
forall a. Maybe a
Nothing
    handler :: b -> IO ()
handler = IO () -> b -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())