{-# 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 qualified Codec.Archive.Zip.Internal as I
import Codec.Archive.Zip.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 qualified Data.Conduit as C
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import qualified Data.DList as DList
import Data.Map.Strict (Map, (!))
import qualified Data.Map.Strict as M
import Data.Sequence (Seq, (|>))
import qualified Data.Sequence as S
import qualified Data.Set 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 qualified System.FilePath 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 -> 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
<$ :: forall a b. a -> ZipArchive b -> ZipArchive a
$c<$ :: forall a b. a -> ZipArchive b -> ZipArchive a
fmap :: forall a b. (a -> b) -> ZipArchive a -> ZipArchive b
$cfmap :: forall a b. (a -> b) -> ZipArchive a -> ZipArchive b
Functor,
      Functor 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
<* :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a
$c<* :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a
*> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
$c*> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
liftA2 :: forall a b c.
(a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c
<*> :: forall a b. ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b
$c<*> :: forall a b. ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b
pure :: forall a. a -> ZipArchive a
$cpure :: forall a. a -> ZipArchive a
Applicative,
      Applicative 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
return :: forall a. a -> ZipArchive a
$creturn :: forall a. a -> ZipArchive a
>> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
$c>> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
>>= :: forall a b. ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
$c>>= :: forall a b. ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
Monad,
      Monad ZipArchive
forall a. IO a -> ZipArchive a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> ZipArchive a
$cliftIO :: forall a. IO a -> ZipArchive a
MonadIO,
      Monad ZipArchive
forall e a. Exception e => e -> ZipArchive a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> ZipArchive a
$cthrowM :: forall e a. Exception e => e -> ZipArchive a
MonadThrow,
      MonadThrow ZipArchive
forall e a.
Exception e =>
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
$ccatch :: forall e a.
Exception e =>
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
MonadCatch,
      MonadCatch ZipArchive
forall b.
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
forall a b c.
ZipArchive a
-> (a -> ExitCase b -> ZipArchive c)
-> (a -> ZipArchive b)
-> ZipArchive (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
ZipArchive a
-> (a -> ExitCase b -> ZipArchive c)
-> (a -> ZipArchive b)
-> ZipArchive (b, c)
$cgeneralBracket :: forall a b c.
ZipArchive a
-> (a -> ExitCase b -> ZipArchive c)
-> (a -> ZipArchive b)
-> ZipArchive (b, c)
uninterruptibleMask :: forall b.
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
$cuninterruptibleMask :: forall b.
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
mask :: forall b.
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
$cmask :: forall b.
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
MonadMask
    )

-- | @since 0.2.0
instance MonadBase IO ZipArchive where
  liftBase :: forall a. IO a -> ZipArchive a
liftBase = 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 = forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \ZipState
s ->
    (,ZipState
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RunInBase ZipArchive IO -> IO a
f (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ZipState
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ZipArchive a -> StateT ZipState IO a
unZipArchive)
  {-# INLINEABLE liftBaseWith #-}
  restoreM :: forall a. StM ZipArchive a -> ZipArchive a
restoreM = forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  FilePath
apath <- FilePath -> IO FilePath
makeAbsolute FilePath
path
  IO () -> IO ()
ignoringAbsence (FilePath -> IO ()
removeFile FilePath
apath)
  let st :: ZipState
st =
        ZipState
          { zsFilePath :: FilePath
zsFilePath = FilePath
apath,
            zsEntries :: Map EntrySelector EntryDescription
zsEntries = forall k a. Map k a
M.empty,
            zsArchive :: ArchiveDescription
zsArchive = Maybe Text -> Natural -> Natural -> ArchiveDescription
ArchiveDescription forall a. Maybe a
Nothing Natural
0 Natural
0,
            zsActions :: Seq PendingAction
zsActions = forall a. Seq a
S.empty
          }
      action :: StateT ZipState IO a
action = forall a. ZipArchive a -> StateT ZipState IO a
unZipArchive (ZipArchive a
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ZipArchive ()
commit)
  forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT ZipState IO a
action ZipState
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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
  FilePath
apath <- FilePath -> IO FilePath
canonicalizePath FilePath
path
  (ArchiveDescription
desc, Map EntrySelector EntryDescription
entries) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
I.scanArchive FilePath
apath)
  let st :: ZipState
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 = forall a. Seq a
S.empty
          }
      action :: StateT ZipState IO a
action = forall a. ZipArchive a -> StateT ZipState IO a
unZipArchive (ZipArchive a
m forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ZipArchive ()
commit)
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT ZipState IO a
action ZipState
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 = forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive (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 = forall k a. Ord k => k -> Map k a -> Bool
M.member EntrySelector
s 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 = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup EntrySelector
s 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 = forall a.
EntrySelector
-> ConduitT ByteString Void (ResourceT IO) a -> ZipArchive a
sourceEntry EntrySelector
s (forall (m :: * -> *) b a o.
(Monad m, Monoid b) =>
(a -> b) -> ConduitT a o m b
CL.foldMap 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
  FilePath
path <- ZipArchive FilePath
getFilePath
  Maybe EntryDescription
mdesc <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup EntrySelector
s forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipArchive (Map EntrySelector EntryDescription)
getEntries
  case Maybe EntryDescription
mdesc of
    Maybe EntryDescription
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> EntrySelector -> ZipException
EntryDoesNotExist FilePath
path EntrySelector
s)
    Just EntryDescription
desc -> forall (m :: * -> *) a. Monad m => a -> m a
return (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
  ConduitT () ByteString (ResourceT IO) ()
src <- forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
EntrySelector -> ZipArchive (ConduitT () ByteString m ())
getEntrySource EntrySelector
s
  (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
C.runConduitRes) (ConduitT () ByteString (ResourceT IO) ()
src forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT ByteString Void (ResourceT IO) a
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
  forall a.
EntrySelector
-> ConduitT ByteString Void (ResourceT IO) a -> ZipArchive a
sourceEntry EntrySelector
s (forall (m :: * -> *) o.
MonadResource m =>
FilePath -> ConduitT ByteString o m ()
CB.sinkFile FilePath
path)
  Maybe EntryDescription
med <- EntrySelector -> ZipArchive (Maybe EntryDescription)
getEntryDesc EntrySelector
s
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe EntryDescription
med (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> UTCTime -> IO ()
setModificationTime FilePath
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryDescription -> UTCTime
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
  Word32
calculated <- forall a.
EntrySelector
-> ConduitT ByteString Void (ResourceT IO) a -> ZipArchive a
sourceEntry EntrySelector
s ConduitT ByteString Void (ResourceT IO) Word32
I.crc32Sink
  Word32
given <- EntryDescription -> Word32
edCRC32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k a. Ord k => Map k a -> k -> a
! EntrySelector
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipArchive (Map EntrySelector EntryDescription)
getEntries
  -- NOTE We can assume that entry exists for sure because otherwise
  -- 'sourceEntry' would have thrown 'EntryDoesNotExist' already.
  forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
calculated forall a. Eq a => a -> a -> Bool
== Word32
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
  Set EntrySelector
selectors <- forall k a. Map k a -> Set k
M.keysSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipArchive (Map EntrySelector EntryDescription)
getEntries
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set EntrySelector
selectors) forall a b. (a -> b) -> a -> b
$ do
    FilePath
dir <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
makeAbsolute FilePath
dir')
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir)
    let dirs :: Set FilePath
dirs = forall b a. Ord b => (a -> b) -> Set a -> Set b
E.map (FilePath -> FilePath
FP.takeDirectory forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
dir FilePath -> FilePath -> FilePath
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntrySelector -> FilePath
unEntrySelector) Set EntrySelector
selectors
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set FilePath
dirs (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set EntrySelector
selectors forall a b. (a -> b) -> a -> b
$ \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 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 = forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive (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
-> ConduitT () ByteString (ResourceT IO) ()
-> EntrySelector
-> PendingAction
I.SinkEntry CompressionMethod
t (forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield 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
  FilePath
apath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
canonicalizePath FilePath
path)
  UTCTime
modTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO UTCTime
getModificationTime FilePath
path)
  let src :: ConduitT () ByteString (ResourceT IO) ()
src = forall (m :: * -> *) i.
MonadResource m =>
FilePath -> ConduitT i ByteString m ()
CB.sourceFile FilePath
apath
  PendingAction -> ZipArchive ()
addPending (CompressionMethod
-> ConduitT () ByteString (ResourceT IO) ()
-> EntrySelector
-> PendingAction
I.SinkEntry CompressionMethod
t ConduitT () ByteString (ResourceT IO) ()
src EntrySelector
s)
  PendingAction -> ZipArchive ()
addPending (UTCTime -> EntrySelector -> PendingAction
I.SetModTime UTCTime
modTime EntrySelector
s)

#ifndef mingw32_HOST_OS
  FileStatus
status <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FileStatus
Unix.getFileStatus FilePath
path
  Word32 -> EntrySelector -> ZipArchive ()
setExternalFileAttrs (CMode -> Word32
Unix.fromFileMode (FileStatus -> CMode
Unix.fileMode FileStatus
status)) EntrySelector
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
  FilePath
apath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
canonicalizePath FilePath
path)
  PendingAction -> ZipArchive ()
addPending (FilePath -> EntrySelector -> EntrySelector -> PendingAction
I.CopyEntry FilePath
apath EntrySelector
s' EntrySelector
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 (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ 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
  [FilePath]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
listDirRecur FilePath
path)
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files forall a b. (a -> b) -> a -> b
$ \FilePath
x -> do
    EntrySelector
s <- FilePath -> ZipArchive EntrySelector
f FilePath
x
    CompressionMethod -> EntrySelector -> FilePath -> ZipArchive ()
loadEntry CompressionMethod
t EntrySelector
s (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
x)
    EntrySelector -> ZipArchive ()
patch EntrySelector
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ EntrySelector -> ZipArchive ()
action forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. (a -> Bool) -> Seq a -> Seq a
S.filter ((forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just EntrySelector
s) 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 = forall a. (a -> Bool) -> Seq a -> Seq a
S.filter ((forall a. Eq a => a -> a -> Bool
/= forall a. Maybe a
Nothing) 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 (forall a b. a -> b -> a
const 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
  FilePath
file <- ZipArchive FilePath
getFilePath
  ArchiveDescription
odesc <- ZipArchive ArchiveDescription
getArchiveDescription
  Map EntrySelector EntryDescription
oentries <- ZipArchive (Map EntrySelector EntryDescription)
getEntries
  Seq PendingAction
actions <- ZipArchive (Seq PendingAction)
getPending
  Bool
exists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
file)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Seq a -> Bool
S.null Seq PendingAction
actions Bool -> Bool -> Bool
&& Bool
exists) forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath
-> ArchiveDescription
-> Map EntrySelector EntryDescription
-> Seq PendingAction
-> IO ()
I.commit FilePath
file ArchiveDescription
odesc Map EntrySelector EntryDescription
oentries Seq PendingAction
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.
    (ArchiveDescription
ndesc, Map EntrySelector EntryDescription
nentries) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
I.scanArchive FilePath
file)
    forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ZipState
st ->
      ZipState
st
        { zsEntries :: Map EntrySelector EntryDescription
zsEntries = Map EntrySelector EntryDescription
nentries,
          zsArchive :: ArchiveDescription
zsArchive = ArchiveDescription
ndesc,
          zsActions :: Seq PendingAction
zsActions = forall a. Seq a
S.empty
        }

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

-- | Get the path of the actual archive file from inside of 'ZipArchive'
-- monad.
getFilePath :: ZipArchive FilePath
getFilePath :: ZipArchive FilePath
getFilePath = forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive (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 = forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive (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 = forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive (forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ZipState -> ZipState
g)
  where
    g :: ZipState -> ZipState
g ZipState
st = ZipState
st {zsActions :: Seq PendingAction
zsActions = Seq PendingAction -> Seq PendingAction
f (ZipState -> Seq PendingAction
zsActions ZipState
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 (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 = forall a. DList a -> [a]
DList.toList 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
      [FilePath]
raw <- FilePath -> IO [FilePath]
listDirectory FilePath
cdir
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
raw forall a b. (a -> b) -> a -> b
$ \case
        FilePath
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
        FilePath
"." -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
        FilePath
".." -> forall (m :: * -> *) a. Monad m => a -> m a
return 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
          Bool
isFile <- FilePath -> IO Bool
doesFileExist FilePath
fullx
          Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist FilePath
fullx
          if Bool
isFile
            then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> DList a
DList.singleton FilePath
adir')
            else
              if Bool
isDir
                then FilePath -> IO (DList FilePath)
go FilePath
adir'
                else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty

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