{-# 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 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 :: 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 FilePath
path 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 Natural
0 Natural
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 FilePath
path 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
(ArchiveDescription
desc, 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 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 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 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 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
Maybe EntryDescription
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 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 EntrySelector
s 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 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)
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 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 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
$ \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 CompressionMethod
t ByteString
b 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 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)
loadEntry ::
CompressionMethod ->
EntrySelector ->
FilePath ->
ZipArchive ()
loadEntry :: CompressionMethod -> EntrySelector -> FilePath -> ZipArchive ()
loadEntry CompressionMethod
t EntrySelector
s 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 FilePath
path EntrySelector
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 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 (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' CompressionMethod
t FilePath -> ZipArchive EntrySelector
f EntrySelector -> ZipArchive ()
patch 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
$ \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 EntrySelector
old EntrySelector
new = PendingAction -> ZipArchive ()
addPending (EntrySelector -> EntrySelector -> PendingAction
I.RenameEntry EntrySelector
old EntrySelector
new)
deleteEntry :: EntrySelector -> ZipArchive ()
deleteEntry :: EntrySelector -> ZipArchive ()
deleteEntry EntrySelector
s = PendingAction -> ZipArchive ()
addPending (EntrySelector -> PendingAction
I.DeleteEntry EntrySelector
s)
recompress ::
CompressionMethod ->
EntrySelector ->
ZipArchive ()
recompress :: CompressionMethod -> EntrySelector -> ZipArchive ()
recompress CompressionMethod
t EntrySelector
s = PendingAction -> ZipArchive ()
addPending (CompressionMethod -> EntrySelector -> PendingAction
I.Recompress CompressionMethod
t EntrySelector
s)
setEntryComment ::
Text ->
EntrySelector ->
ZipArchive ()
Text
text EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Text -> EntrySelector -> PendingAction
I.SetEntryComment Text
text EntrySelector
s)
deleteEntryComment :: EntrySelector -> ZipArchive ()
EntrySelector
s = PendingAction -> ZipArchive ()
addPending (EntrySelector -> PendingAction
I.DeleteEntryComment EntrySelector
s)
setModTime ::
UTCTime ->
EntrySelector ->
ZipArchive ()
setModTime :: UTCTime -> EntrySelector -> ZipArchive ()
setModTime UTCTime
time EntrySelector
s = PendingAction -> ZipArchive ()
addPending (UTCTime -> EntrySelector -> PendingAction
I.SetModTime UTCTime
time EntrySelector
s)
addExtraField ::
Word16 ->
ByteString ->
EntrySelector ->
ZipArchive ()
Word16
n ByteString
b EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Word16 -> ByteString -> EntrySelector -> PendingAction
I.AddExtraField Word16
n ByteString
b EntrySelector
s)
deleteExtraField ::
Word16 ->
EntrySelector ->
ZipArchive ()
Word16
n EntrySelector
s = PendingAction -> ZipArchive ()
addPending (Word16 -> EntrySelector -> PendingAction
I.DeleteExtraField Word16
n EntrySelector
s)
setExternalFileAttrs ::
Word32 ->
EntrySelector ->
ZipArchive ()
setExternalFileAttrs :: Word32 -> EntrySelector -> ZipArchive ()
setExternalFileAttrs Word32
attrs EntrySelector
s =
PendingAction -> ZipArchive ()
addPending (Word32 -> EntrySelector -> PendingAction
I.SetExternalFileAttributes Word32
attrs EntrySelector
s)
forEntries ::
(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 (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 = PendingAction -> ZipArchive ()
addPending (Text -> PendingAction
I.SetArchiveComment Text
text)
deleteArchiveComment :: ZipArchive ()
= PendingAction -> ZipArchive ()
addPending PendingAction
I.DeleteArchiveComment
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)
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)
(ArchiveDescription
ndesc, 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
$ \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 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 :: Seq PendingAction
zsActions = Seq PendingAction -> Seq PendingAction
f (ZipState -> Seq PendingAction
zsActions ZipState
st)}
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)
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
[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
FilePath
"" -> DList FilePath -> IO (DList FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
FilePath
"." -> DList FilePath -> IO (DList FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return DList FilePath
forall a. Monoid a => a
mempty
FilePath
".." -> DList FilePath -> IO (DList FilePath)
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
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 = (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 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 ())