{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Codec.Archive.Zip
(
EntrySelector,
mkEntrySelector,
unEntrySelector,
getEntryName,
EntrySelectorException (..),
EntryDescription (..),
CompressionMethod (..),
ArchiveDescription (..),
ZipException (..),
ZipArchive,
ZipState,
createArchive,
withArchive,
getEntries,
doesEntryExist,
getEntryDesc,
getEntry,
getEntrySource,
sourceEntry,
saveEntry,
checkEntry,
unpackInto,
getArchiveComment,
getArchiveDescription,
addEntry,
sinkEntry,
loadEntry,
copyEntry,
packDirRecur,
packDirRecur',
renameEntry,
deleteEntry,
recompress,
setEntryComment,
deleteEntryComment,
setModTime,
addExtraField,
deleteExtraField,
setExternalFileAttrs,
forEntries,
setArchiveComment,
deleteArchiveComment,
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
newtype ZipArchive a = ZipArchive
{ ZipArchive a -> StateT ZipState IO a
unZipArchive :: StateT ZipState IO a
}
deriving
( a -> ZipArchive b -> ZipArchive a
(a -> b) -> ZipArchive a -> ZipArchive b
(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
<$ :: a -> ZipArchive b -> ZipArchive a
$c<$ :: forall a b. a -> ZipArchive b -> ZipArchive a
fmap :: (a -> b) -> ZipArchive a -> ZipArchive b
$cfmap :: forall a b. (a -> b) -> ZipArchive a -> ZipArchive b
Functor,
Functor ZipArchive
a -> ZipArchive a
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
ZipArchive a -> ZipArchive b -> ZipArchive b
ZipArchive a -> ZipArchive b -> ZipArchive a
ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b
(a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c
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
<* :: ZipArchive a -> ZipArchive b -> ZipArchive a
$c<* :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive a
*> :: ZipArchive a -> ZipArchive b -> ZipArchive b
$c*> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
liftA2 :: (a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ZipArchive a -> ZipArchive b -> ZipArchive c
<*> :: ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b
$c<*> :: forall a b. ZipArchive (a -> b) -> ZipArchive a -> ZipArchive b
pure :: a -> ZipArchive a
$cpure :: forall a. a -> ZipArchive a
$cp1Applicative :: Functor ZipArchive
Applicative,
Applicative ZipArchive
a -> ZipArchive a
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
ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
ZipArchive a -> ZipArchive b -> ZipArchive b
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 :: a -> ZipArchive a
$creturn :: forall a. a -> ZipArchive a
>> :: ZipArchive a -> ZipArchive b -> ZipArchive b
$c>> :: forall a b. ZipArchive a -> ZipArchive b -> ZipArchive b
>>= :: ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
$c>>= :: forall a b. ZipArchive a -> (a -> ZipArchive b) -> ZipArchive b
$cp1Monad :: Applicative ZipArchive
Monad,
Monad ZipArchive
Monad ZipArchive =>
(forall a. IO a -> ZipArchive a) -> MonadIO ZipArchive
IO a -> ZipArchive a
forall a. IO a -> ZipArchive a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ZipArchive a
$cliftIO :: forall a. IO a -> ZipArchive a
$cp1MonadIO :: Monad ZipArchive
MonadIO,
Monad ZipArchive
e -> ZipArchive a
Monad ZipArchive =>
(forall e a. Exception e => e -> ZipArchive a)
-> MonadThrow ZipArchive
forall e a. Exception e => e -> ZipArchive a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> ZipArchive a
$cthrowM :: forall e a. Exception e => e -> ZipArchive a
$cp1MonadThrow :: Monad ZipArchive
MonadThrow,
MonadThrow ZipArchive
MonadThrow ZipArchive =>
(forall e a.
Exception e =>
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a)
-> MonadCatch ZipArchive
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
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 :: ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
$ccatch :: forall e a.
Exception e =>
ZipArchive a -> (e -> ZipArchive a) -> ZipArchive a
$cp1MonadCatch :: MonadThrow ZipArchive
MonadCatch,
MonadCatch ZipArchive
MonadCatch ZipArchive =>
(forall b.
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b)
-> (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))
-> MonadMask ZipArchive
ZipArchive a
-> (a -> ExitCase b -> ZipArchive c)
-> (a -> ZipArchive b)
-> ZipArchive (b, c)
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
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 :: 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 a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
$cuninterruptibleMask :: forall b.
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
mask :: ((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
$cmask :: forall b.
((forall a. ZipArchive a -> ZipArchive a) -> ZipArchive b)
-> ZipArchive b
$cp1MonadMask :: MonadCatch ZipArchive
MonadMask
)
instance MonadBase IO ZipArchive where
liftBase :: IO α -> ZipArchive α
liftBase = IO α -> ZipArchive α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
instance MonadBaseControl IO ZipArchive where
type StM ZipArchive a = (a, ZipState)
liftBaseWith :: (RunInBase ZipArchive IO -> IO a) -> ZipArchive a
liftBaseWith f :: 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
$ \s :: 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 :: 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 (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINEABLE restoreM #-}
data ZipState = ZipState
{
ZipState -> FilePath
zsFilePath :: FilePath,
ZipState -> Map EntrySelector EntryDescription
zsEntries :: Map EntrySelector EntryDescription,
ZipState -> ArchiveDescription
zsArchive :: ArchiveDescription,
ZipState -> Seq PendingAction
zsActions :: Seq I.PendingAction
}
createArchive ::
MonadIO m =>
FilePath ->
ZipArchive a ->
m a
createArchive :: FilePath -> ZipArchive a -> m a
createArchive path :: FilePath
path m :: ZipArchive a
m = 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
FilePath
apath <- FilePath -> IO FilePath
makeAbsolute FilePath
path
IO () -> IO ()
ignoringAbsence (FilePath -> IO ()
removeFile FilePath
apath)
let st :: ZipState
st =
ZipState :: FilePath
-> Map EntrySelector EntryDescription
-> ArchiveDescription
-> Seq PendingAction
-> ZipState
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 0 0,
zsActions :: Seq PendingAction
zsActions = Seq PendingAction
forall a. Seq a
S.empty
}
action :: StateT ZipState IO a
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ZipArchive ()
commit)
StateT ZipState IO a -> ZipState -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT ZipState IO a
action ZipState
st
withArchive ::
MonadIO m =>
FilePath ->
ZipArchive a ->
m a
withArchive :: FilePath -> ZipArchive a -> m a
withArchive path :: FilePath
path m :: ZipArchive a
m = 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
FilePath
apath <- FilePath -> IO FilePath
canonicalizePath FilePath
path
(desc :: ArchiveDescription
desc, entries :: Map EntrySelector EntryDescription
entries) <- IO (ArchiveDescription, Map EntrySelector EntryDescription)
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
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 :: FilePath
-> Map EntrySelector EntryDescription
-> ArchiveDescription
-> Seq PendingAction
-> ZipState
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 :: StateT ZipState IO a
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ZipArchive ()
commit)
IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (StateT ZipState IO a -> ZipState -> IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT ZipState IO a
action ZipState
st)
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)
doesEntryExist :: EntrySelector -> ZipArchive Bool
doesEntryExist :: EntrySelector -> ZipArchive Bool
doesEntryExist s :: 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
getEntryDesc :: EntrySelector -> ZipArchive (Maybe EntryDescription)
getEntryDesc :: EntrySelector -> ZipArchive (Maybe EntryDescription)
getEntryDesc s :: 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
getEntry ::
EntrySelector ->
ZipArchive ByteString
getEntry :: EntrySelector -> ZipArchive ByteString
getEntry s :: 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)
getEntrySource ::
(PrimMonad m, MonadThrow m, MonadResource m) =>
EntrySelector ->
ZipArchive (ConduitT () ByteString m ())
getEntrySource :: EntrySelector -> ZipArchive (ConduitT () ByteString m ())
getEntrySource s :: EntrySelector
s = do
FilePath
path <- ZipArchive FilePath
getFilePath
Maybe EntryDescription
mdesc <- 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
case Maybe EntryDescription
mdesc of
Nothing -> ZipException -> ZipArchive (ConduitT () ByteString m ())
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> EntrySelector -> ZipException
EntryDoesNotExist FilePath
path EntrySelector
s)
Just desc :: EntryDescription
desc -> ConduitT () ByteString m ()
-> ZipArchive (ConduitT () ByteString m ())
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)
sourceEntry ::
EntrySelector ->
ConduitT ByteString Void (ResourceT IO) a ->
ZipArchive a
sourceEntry :: EntrySelector
-> ConduitT ByteString Void (ResourceT IO) a -> ZipArchive a
sourceEntry s :: EntrySelector
s sink :: ConduitT ByteString Void (ResourceT IO) a
sink = do
ConduitT () ByteString (ResourceT IO) ()
src <- EntrySelector
-> ZipArchive (ConduitT () ByteString (ResourceT IO) ())
forall (m :: * -> *).
(PrimMonad m, MonadThrow m, MonadResource m) =>
EntrySelector -> ZipArchive (ConduitT () ByteString m ())
getEntrySource EntrySelector
s
(IO a -> ZipArchive a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> ZipArchive a)
-> (ConduitT () Void (ResourceT IO) a -> IO a)
-> ConduitT () Void (ResourceT IO) a
-> ZipArchive a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (ResourceT IO) a -> IO a
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
C.runConduitRes) (ConduitT () ByteString (ResourceT IO) ()
src ConduitT () ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) a
-> ConduitT () Void (ResourceT IO) a
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT ByteString Void (ResourceT IO) a
sink)
saveEntry ::
EntrySelector ->
FilePath ->
ZipArchive ()
saveEntry :: EntrySelector -> FilePath -> ZipArchive ()
saveEntry s :: EntrySelector
s path :: 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)
Maybe EntryDescription
med <- EntrySelector -> ZipArchive (Maybe EntryDescription)
getEntryDesc EntrySelector
s
Maybe EntryDescription
-> (EntryDescription -> ZipArchive ()) -> ZipArchive ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe EntryDescription
med (IO () -> ZipArchive ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ZipArchive ())
-> (EntryDescription -> IO ()) -> EntryDescription -> ZipArchive ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> UTCTime -> IO ()
setModificationTime FilePath
path (UTCTime -> IO ())
-> (EntryDescription -> UTCTime) -> EntryDescription -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryDescription -> UTCTime
edModTime)
checkEntry ::
EntrySelector ->
ZipArchive Bool
checkEntry :: EntrySelector -> ZipArchive Bool
checkEntry s :: EntrySelector
s = do
Word32
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
Word32
given <- EntryDescription -> Word32
edCRC32 (EntryDescription -> Word32)
-> (Map EntrySelector EntryDescription -> EntryDescription)
-> Map EntrySelector EntryDescription
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map EntrySelector EntryDescription
-> EntrySelector -> EntryDescription
forall k a. Ord k => Map k a -> k -> a
! EntrySelector
s) (Map EntrySelector EntryDescription -> Word32)
-> ZipArchive (Map EntrySelector EntryDescription)
-> ZipArchive Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipArchive (Map EntrySelector EntryDescription)
getEntries
Bool -> ZipArchive Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
calculated Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
given)
unpackInto :: FilePath -> ZipArchive ()
unpackInto :: FilePath -> ZipArchive ()
unpackInto dir' :: FilePath
dir' = do
Set EntrySelector
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
Bool -> ZipArchive () -> ZipArchive ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set EntrySelector -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set EntrySelector
selectors) (ZipArchive () -> ZipArchive ()) -> ZipArchive () -> ZipArchive ()
forall a b. (a -> b) -> a -> b
$ do
FilePath
dir <- IO FilePath -> ZipArchive FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
makeAbsolute FilePath
dir')
IO () -> ZipArchive ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir)
let dirs :: Set FilePath
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
Set FilePath -> (FilePath -> ZipArchive ()) -> ZipArchive ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set FilePath
dirs (IO () -> ZipArchive ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ZipArchive ())
-> (FilePath -> IO ()) -> FilePath -> ZipArchive ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True)
Set EntrySelector
-> (EntrySelector -> ZipArchive ()) -> ZipArchive ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set EntrySelector
selectors ((EntrySelector -> ZipArchive ()) -> ZipArchive ())
-> (EntrySelector -> ZipArchive ()) -> ZipArchive ()
forall a b. (a -> b) -> a -> b
$ \s :: EntrySelector
s ->
EntrySelector -> FilePath -> ZipArchive ()
saveEntry EntrySelector
s (FilePath
dir FilePath -> FilePath -> FilePath
</> EntrySelector -> FilePath
unEntrySelector EntrySelector
s)
getArchiveComment :: ZipArchive (Maybe Text)
= 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
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)
addEntry ::
CompressionMethod ->
ByteString ->
EntrySelector ->
ZipArchive ()
addEntry :: CompressionMethod -> ByteString -> EntrySelector -> ZipArchive ()
addEntry t :: CompressionMethod
t b :: ByteString
b s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (CompressionMethod
-> ConduitT () ByteString (ResourceT IO) ()
-> EntrySelector
-> PendingAction
I.SinkEntry CompressionMethod
t (ByteString -> ConduitT () ByteString (ResourceT IO) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
C.yield ByteString
b) EntrySelector
s)
sinkEntry ::
CompressionMethod ->
ConduitT () ByteString (ResourceT IO) () ->
EntrySelector ->
ZipArchive ()
sinkEntry :: CompressionMethod
-> ConduitT () ByteString (ResourceT IO) ()
-> EntrySelector
-> ZipArchive ()
sinkEntry t :: CompressionMethod
t src :: ConduitT () ByteString (ResourceT IO) ()
src s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (CompressionMethod
-> ConduitT () ByteString (ResourceT IO) ()
-> EntrySelector
-> PendingAction
I.SinkEntry CompressionMethod
t ConduitT () ByteString (ResourceT IO) ()
src EntrySelector
s)
loadEntry ::
CompressionMethod ->
EntrySelector ->
FilePath ->
ZipArchive ()
loadEntry :: CompressionMethod -> EntrySelector -> FilePath -> ZipArchive ()
loadEntry t :: CompressionMethod
t s :: EntrySelector
s path :: FilePath
path = do
FilePath
apath <- IO FilePath -> ZipArchive FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO FilePath
canonicalizePath FilePath
path)
UTCTime
modTime <- IO UTCTime -> ZipArchive UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO UTCTime
getModificationTime FilePath
path)
let src :: ConduitT () ByteString (ResourceT IO) ()
src = FilePath -> ConduitT () ByteString (ResourceT IO) ()
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 <- IO FileStatus -> ZipArchive FileStatus
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileStatus -> ZipArchive FileStatus)
-> IO FileStatus -> ZipArchive FileStatus
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
copyEntry ::
FilePath ->
EntrySelector ->
EntrySelector ->
ZipArchive ()
copyEntry :: FilePath -> EntrySelector -> EntrySelector -> ZipArchive ()
copyEntry path :: FilePath
path s' :: EntrySelector
s' s :: EntrySelector
s = do
FilePath
apath <- IO FilePath -> ZipArchive FilePath
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)
packDirRecur ::
CompressionMethod ->
(FilePath -> ZipArchive EntrySelector) ->
FilePath ->
ZipArchive ()
packDirRecur :: CompressionMethod
-> (FilePath -> ZipArchive EntrySelector)
-> FilePath
-> ZipArchive ()
packDirRecur t :: CompressionMethod
t f :: 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 (m :: * -> *) a. Monad m => a -> m a
return ())
packDirRecur' ::
CompressionMethod ->
(FilePath -> ZipArchive EntrySelector) ->
(EntrySelector -> ZipArchive ()) ->
FilePath ->
ZipArchive ()
packDirRecur' :: CompressionMethod
-> (FilePath -> ZipArchive EntrySelector)
-> (EntrySelector -> ZipArchive ())
-> FilePath
-> ZipArchive ()
packDirRecur' t :: CompressionMethod
t f :: FilePath -> ZipArchive EntrySelector
f patch :: EntrySelector -> ZipArchive ()
patch path :: FilePath
path = do
[FilePath]
files <- IO [FilePath] -> ZipArchive [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
listDirRecur FilePath
path)
[FilePath] -> (FilePath -> ZipArchive ()) -> ZipArchive ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> ZipArchive ()) -> ZipArchive ())
-> (FilePath -> ZipArchive ()) -> ZipArchive ()
forall a b. (a -> b) -> a -> b
$ \x :: 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
renameEntry ::
EntrySelector ->
EntrySelector ->
ZipArchive ()
renameEntry :: EntrySelector -> EntrySelector -> ZipArchive ()
renameEntry old :: EntrySelector
old new :: EntrySelector
new = PendingAction -> ZipArchive ()
addPending (EntrySelector -> EntrySelector -> PendingAction
I.RenameEntry EntrySelector
old EntrySelector
new)
deleteEntry :: EntrySelector -> ZipArchive ()
deleteEntry :: EntrySelector -> ZipArchive ()
deleteEntry s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (EntrySelector -> PendingAction
I.DeleteEntry EntrySelector
s)
recompress ::
CompressionMethod ->
EntrySelector ->
ZipArchive ()
recompress :: CompressionMethod -> EntrySelector -> ZipArchive ()
recompress t :: CompressionMethod
t s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (CompressionMethod -> EntrySelector -> PendingAction
I.Recompress CompressionMethod
t EntrySelector
s)
setEntryComment ::
Text ->
EntrySelector ->
ZipArchive ()
text :: Text
text s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Text -> EntrySelector -> PendingAction
I.SetEntryComment Text
text EntrySelector
s)
deleteEntryComment :: EntrySelector -> ZipArchive ()
s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (EntrySelector -> PendingAction
I.DeleteEntryComment EntrySelector
s)
setModTime ::
UTCTime ->
EntrySelector ->
ZipArchive ()
setModTime :: UTCTime -> EntrySelector -> ZipArchive ()
setModTime time :: UTCTime
time s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (UTCTime -> EntrySelector -> PendingAction
I.SetModTime UTCTime
time EntrySelector
s)
addExtraField ::
Word16 ->
ByteString ->
EntrySelector ->
ZipArchive ()
n :: Word16
n b :: ByteString
b s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Word16 -> ByteString -> EntrySelector -> PendingAction
I.AddExtraField Word16
n ByteString
b EntrySelector
s)
deleteExtraField ::
Word16 ->
EntrySelector ->
ZipArchive ()
n :: Word16
n s :: EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Word16 -> EntrySelector -> PendingAction
I.DeleteExtraField Word16
n EntrySelector
s)
setExternalFileAttrs ::
Word32 ->
EntrySelector ->
ZipArchive ()
setExternalFileAttrs :: Word32 -> EntrySelector -> ZipArchive ()
setExternalFileAttrs attrs :: Word32
attrs s :: EntrySelector
s =
PendingAction -> ZipArchive ()
addPending (Word32 -> EntrySelector -> PendingAction
I.SetExternalFileAttributes Word32
attrs EntrySelector
s)
forEntries ::
(EntrySelector -> ZipArchive ()) ->
ZipArchive ()
forEntries :: (EntrySelector -> ZipArchive ()) -> ZipArchive ()
forEntries action :: EntrySelector -> ZipArchive ()
action = ZipArchive (Map EntrySelector EntryDescription)
getEntries ZipArchive (Map EntrySelector EntryDescription)
-> (Map EntrySelector EntryDescription -> ZipArchive ())
-> ZipArchive ()
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
setArchiveComment :: Text -> ZipArchive ()
text :: Text
text = PendingAction -> ZipArchive ()
addPending (Text -> PendingAction
I.SetArchiveComment Text
text)
deleteArchiveComment :: ZipArchive ()
= PendingAction -> ZipArchive ()
addPending PendingAction
I.DeleteArchiveComment
undoEntryChanges :: EntrySelector -> ZipArchive ()
undoEntryChanges :: EntrySelector -> ZipArchive ()
undoEntryChanges s :: 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)
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)
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)
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 <- IO Bool -> ZipArchive Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
file)
Bool -> ZipArchive () -> ZipArchive ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Seq PendingAction -> Bool
forall a. Seq a -> Bool
S.null Seq PendingAction
actions Bool -> Bool -> Bool
&& Bool
exists) (ZipArchive () -> ZipArchive ()) -> ZipArchive () -> ZipArchive ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> ZipArchive ()
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)
(ndesc :: ArchiveDescription
ndesc, nentries :: Map EntrySelector EntryDescription
nentries) <- IO (ArchiveDescription, Map EntrySelector EntryDescription)
-> ZipArchive
(ArchiveDescription, Map EntrySelector EntryDescription)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath
-> IO (ArchiveDescription, Map EntrySelector EntryDescription)
I.scanArchive FilePath
file)
StateT ZipState IO () -> ZipArchive ()
forall a. StateT ZipState IO a -> ZipArchive a
ZipArchive (StateT ZipState IO () -> ZipArchive ())
-> ((ZipState -> ZipState) -> StateT ZipState IO ())
-> (ZipState -> ZipState)
-> ZipArchive ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ZipState -> ZipState) -> StateT ZipState IO ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ZipState -> ZipState) -> ZipArchive ())
-> (ZipState -> ZipState) -> ZipArchive ()
forall a b. (a -> b) -> a -> b
$ \st :: ZipState
st ->
ZipState
st
{ zsEntries :: Map EntrySelector EntryDescription
zsEntries = Map EntrySelector EntryDescription
nentries,
zsArchive :: ArchiveDescription
zsArchive = ArchiveDescription
ndesc,
zsActions :: Seq PendingAction
zsActions = Seq PendingAction
forall a. Seq a
S.empty
}
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)
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)
modifyActions :: (Seq I.PendingAction -> Seq I.PendingAction) -> ZipArchive ()
modifyActions :: (Seq PendingAction -> Seq PendingAction) -> ZipArchive ()
modifyActions f :: 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 st :: ZipState
st = ZipState
st {zsActions :: Seq PendingAction
zsActions = Seq PendingAction -> Seq PendingAction
f (ZipState -> Seq PendingAction
zsActions ZipState
st)}
addPending :: I.PendingAction -> ZipArchive ()
addPending :: PendingAction -> ZipArchive ()
addPending a :: PendingAction
a = (Seq PendingAction -> Seq PendingAction) -> ZipArchive ()
modifyActions (Seq PendingAction -> PendingAction -> Seq PendingAction
forall a. Seq a -> a -> Seq a
|> PendingAction
a)
listDirRecur :: FilePath -> IO [FilePath]
listDirRecur :: FilePath -> IO [FilePath]
listDirRecur path :: 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 ""
where
go :: FilePath -> IO (DList FilePath)
go adir :: FilePath
adir = do
let cdir :: FilePath
cdir = FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
adir
[FilePath]
raw <- FilePath -> IO [FilePath]
listDirectory FilePath
cdir
([DList FilePath] -> DList FilePath)
-> IO [DList FilePath] -> IO (DList FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [DList FilePath] -> DList FilePath
forall a. Monoid a => [a] -> a
mconcat (IO [DList FilePath] -> IO (DList FilePath))
-> ((FilePath -> IO (DList FilePath)) -> IO [DList FilePath])
-> (FilePath -> IO (DList FilePath))
-> IO (DList FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath]
-> (FilePath -> IO (DList FilePath)) -> IO [DList FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
raw ((FilePath -> IO (DList FilePath)) -> IO (DList FilePath))
-> (FilePath -> IO (DList FilePath)) -> IO (DList FilePath)
forall a b. (a -> b) -> a -> b
$ \case
"" -> DList FilePath -> IO (DList FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
"." -> DList FilePath -> IO (DList FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
".." -> DList FilePath -> IO (DList FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
x :: 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 DList FilePath -> IO (DList FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> DList FilePath
forall a. a -> DList a
DList.singleton FilePath
adir')
else
if Bool
isDir
then FilePath -> IO (DList FilePath)
go FilePath
adir'
else DList FilePath -> IO (DList FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
ignoringAbsence :: IO () -> IO ()
ignoringAbsence :: IO () -> IO ()
ignoringAbsence io :: IO ()
io = (IOError -> Maybe IOError) -> IO () -> (IOError -> 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 IOError -> IO ()
forall b. b -> IO ()
handler
where
select :: IOError -> Maybe IOError
select e :: 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 (m :: * -> *) a. Monad m => a -> m a
return ())