module Codec.Archive.Pack ( entriesToFile
, entriesToFileZip
, entriesToFile7Zip
, entriesToFileCpio
, entriesToFileXar
, entriesToBS
, entriesToBSzip
, entriesToBS7zip
, packEntries
, noFail
, packToFile
, packToFileZip
, packToFile7Zip
, packToFileCpio
, packToFileXar
) where
import Codec.Archive.Foreign
import Codec.Archive.Monad
import Codec.Archive.Pack.Common
import Codec.Archive.Types
import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString (packCStringLen)
import qualified Data.ByteString as BS
import Data.Coerce (coerce)
import Data.Foldable (sequenceA_, traverse_)
import Data.Semigroup (Sum (..))
import Foreign.C.String
import Foreign.C.Types (CLLong (..), CLong (..))
import Foreign.Ptr (Ptr)
import System.IO.Unsafe (unsafeDupablePerformIO)
maybeDo :: Applicative f => Maybe (f ()) -> f ()
maybeDo :: Maybe (f ()) -> f ()
maybeDo = Maybe (f ()) -> f ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_
contentAdd :: EntryContent -> Ptr Archive -> Ptr ArchiveEntry -> ArchiveM ()
contentAdd :: EntryContent -> Ptr Archive -> Ptr ArchiveEntry -> ArchiveM ()
contentAdd (NormalFile ByteString
contents) Ptr Archive
a Ptr ArchiveEntry
entry = do
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Maybe FileType -> IO ()
archiveEntrySetFiletype Ptr ArchiveEntry
entry (FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FtRegular)
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> LaInt64 -> IO ()
archiveEntrySetSize Ptr ArchiveEntry
entry (Int -> LaInt64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
contents))
IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveResult
archiveWriteHeader Ptr Archive
a Ptr ArchiveEntry
entry
ByteString -> (CStringLen -> ArchiveM ()) -> ArchiveM ()
forall a b.
ByteString -> (CStringLen -> ExceptT a IO b) -> ExceptT a IO b
useAsCStringLenArchiveM ByteString
contents ((CStringLen -> ArchiveM ()) -> ArchiveM ())
-> (CStringLen -> ArchiveM ()) -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
buff, Int
sz) ->
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ IO LaInt64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO LaInt64 -> IO ()) -> IO LaInt64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr CChar -> CSize -> IO LaInt64
forall a. Ptr Archive -> Ptr a -> CSize -> IO LaInt64
archiveWriteData Ptr Archive
a Ptr CChar
buff (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
contentAdd EntryContent
Directory Ptr Archive
a Ptr ArchiveEntry
entry = do
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Maybe FileType -> IO ()
archiveEntrySetFiletype Ptr ArchiveEntry
entry (FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FtDirectory)
IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveResult
archiveWriteHeader Ptr Archive
a Ptr ArchiveEntry
entry
contentAdd (Symlink FilePath
fp Symlink
st) Ptr Archive
a Ptr ArchiveEntry
entry = do
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Maybe FileType -> IO ()
archiveEntrySetFiletype Ptr ArchiveEntry
entry (FileType -> Maybe FileType
forall a. a -> Maybe a
Just FileType
FtLink)
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Symlink -> IO ()
archiveEntrySetSymlinkType Ptr ArchiveEntry
entry Symlink
st
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (Ptr CChar -> IO ()) -> IO ()
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
fp ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc ->
Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetSymlink Ptr ArchiveEntry
entry Ptr CChar
fpc
IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveResult
archiveWriteHeader Ptr Archive
a Ptr ArchiveEntry
entry
contentAdd (Hardlink FilePath
fp) Ptr Archive
a Ptr ArchiveEntry
entry = do
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Maybe FileType -> IO ()
archiveEntrySetFiletype Ptr ArchiveEntry
entry Maybe FileType
forall a. Maybe a
Nothing
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (Ptr CChar -> IO ()) -> IO ()
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
fp ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc ->
Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetHardlink Ptr ArchiveEntry
entry Ptr CChar
fpc
IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr ArchiveEntry -> IO ArchiveResult
archiveWriteHeader Ptr Archive
a Ptr ArchiveEntry
entry
withMaybeCString :: Maybe String -> (Maybe CString -> IO a) -> IO a
withMaybeCString :: Maybe FilePath -> (Maybe (Ptr CChar) -> IO a) -> IO a
withMaybeCString (Just FilePath
x) Maybe (Ptr CChar) -> IO a
f = FilePath -> (Ptr CChar -> IO a) -> IO a
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
x (Maybe (Ptr CChar) -> IO a
f (Maybe (Ptr CChar) -> IO a)
-> (Ptr CChar -> Maybe (Ptr CChar)) -> Ptr CChar -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr CChar -> Maybe (Ptr CChar)
forall a. a -> Maybe a
Just)
withMaybeCString Maybe FilePath
Nothing Maybe (Ptr CChar) -> IO a
f = Maybe (Ptr CChar) -> IO a
f Maybe (Ptr CChar)
forall a. Maybe a
Nothing
setOwnership :: Ownership -> Ptr ArchiveEntry -> IO ()
setOwnership :: Ownership -> Ptr ArchiveEntry -> IO ()
setOwnership (Ownership Maybe FilePath
uname Maybe FilePath
gname Id
uid Id
gid) Ptr ArchiveEntry
entry =
Maybe FilePath -> (Maybe (Ptr CChar) -> IO ()) -> IO ()
forall a. Maybe FilePath -> (Maybe (Ptr CChar) -> IO a) -> IO a
withMaybeCString Maybe FilePath
uname ((Maybe (Ptr CChar) -> IO ()) -> IO ())
-> (Maybe (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe (Ptr CChar)
unameC ->
Maybe FilePath -> (Maybe (Ptr CChar) -> IO ()) -> IO ()
forall a. Maybe FilePath -> (Maybe (Ptr CChar) -> IO a) -> IO a
withMaybeCString Maybe FilePath
gname ((Maybe (Ptr CChar) -> IO ()) -> IO ())
-> (Maybe (Ptr CChar) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Maybe (Ptr CChar)
gnameC ->
(Maybe (IO ()) -> IO ()) -> [Maybe (IO ())] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Maybe (IO ()) -> IO ()
forall (f :: * -> *). Applicative f => Maybe (f ()) -> f ()
maybeDo
[ Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetUname Ptr ArchiveEntry
entry (Ptr CChar -> IO ()) -> Maybe (Ptr CChar) -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Ptr CChar)
unameC
, Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetGname Ptr ArchiveEntry
entry (Ptr CChar -> IO ()) -> Maybe (Ptr CChar) -> Maybe (IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Ptr CChar)
gnameC
, IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (Ptr ArchiveEntry -> LaInt64 -> IO ()
archiveEntrySetUid Ptr ArchiveEntry
entry (Id -> LaInt64
coerce Id
uid))
, IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (Ptr ArchiveEntry -> LaInt64 -> IO ()
archiveEntrySetGid Ptr ArchiveEntry
entry (Id -> LaInt64
coerce Id
gid))
]
setTime :: ModTime -> Ptr ArchiveEntry -> IO ()
setTime :: ModTime -> Ptr ArchiveEntry -> IO ()
setTime (CTime
time', LaInt64
nsec) Ptr ArchiveEntry
entry = Ptr ArchiveEntry -> CTime -> LaInt64 -> IO ()
archiveEntrySetMtime Ptr ArchiveEntry
entry CTime
time' LaInt64
nsec
packEntries :: (Foldable t) => Ptr Archive -> t Entry -> ArchiveM ()
packEntries :: Ptr Archive -> t Entry -> ArchiveM ()
packEntries Ptr Archive
a = (Entry -> ArchiveM ()) -> t Entry -> ArchiveM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Ptr Archive -> Entry -> ArchiveM ()
archiveEntryAdd Ptr Archive
a)
entriesSz :: (Foldable t, Integral a) => t Entry -> a
entriesSz :: t Entry -> a
entriesSz = Sum a -> a
forall a. Sum a -> a
getSum (Sum a -> a) -> (t Entry -> Sum a) -> t Entry -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry -> Sum a) -> t Entry -> Sum a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (a -> Sum a
forall a. a -> Sum a
Sum (a -> Sum a) -> (Entry -> a) -> Entry -> Sum a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry -> a
forall a. Integral a => Entry -> a
entrySz)
where entrySz :: Entry -> a
entrySz Entry
e = a
512 a -> a -> a
forall a. Num a => a -> a -> a
+ a
512 a -> a -> a
forall a. Num a => a -> a -> a
* (EntryContent -> a
forall p. Num p => EntryContent -> p
contentSz (Entry -> EntryContent
content Entry
e) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
512 a -> a -> a
forall a. Num a => a -> a -> a
+ a
1)
contentSz :: EntryContent -> p
contentSz (NormalFile ByteString
str) = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> p) -> Int -> p
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
str
contentSz EntryContent
Directory = p
0
contentSz (Symlink FilePath
fp Symlink
_) = p
1 p -> p -> p
forall a. Num a => a -> a -> a
+ Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
fp)
contentSz (Hardlink FilePath
fp) = Int -> p
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> p) -> Int -> p
forall a b. (a -> b) -> a -> b
$ FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
fp
entriesToBS :: Foldable t => t Entry -> BS.ByteString
entriesToBS :: t Entry -> ByteString
entriesToBS = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t Entry -> IO ByteString) -> t Entry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM ByteString -> IO ByteString
forall a. ArchiveM a -> IO a
noFail (ArchiveM ByteString -> IO ByteString)
-> (t Entry -> ArchiveM ByteString) -> t Entry -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
entriesToBSGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatPaxRestricted
{-# NOINLINE entriesToBS #-}
entriesToBS7zip :: Foldable t => t Entry -> BS.ByteString
entriesToBS7zip :: t Entry -> ByteString
entriesToBS7zip = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t Entry -> IO ByteString) -> t Entry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM ByteString -> IO ByteString
forall a. ArchiveM a -> IO a
noFail (ArchiveM ByteString -> IO ByteString)
-> (t Entry -> ArchiveM ByteString) -> t Entry -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
entriesToBSGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormat7zip
{-# NOINLINE entriesToBS7zip #-}
entriesToBSzip :: Foldable t => t Entry -> BS.ByteString
entriesToBSzip :: t Entry -> ByteString
entriesToBSzip = IO ByteString -> ByteString
forall a. IO a -> a
unsafeDupablePerformIO (IO ByteString -> ByteString)
-> (t Entry -> IO ByteString) -> t Entry -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM ByteString -> IO ByteString
forall a. ArchiveM a -> IO a
noFail (ArchiveM ByteString -> IO ByteString)
-> (t Entry -> ArchiveM ByteString) -> t Entry -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
entriesToBSGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatZip
{-# NOINLINE entriesToBSzip #-}
noFail :: ArchiveM a -> IO a
noFail :: ArchiveM a -> IO a
noFail ArchiveM a
act = do
Either ArchiveResult a
res <- ArchiveM a -> IO (Either ArchiveResult a)
forall a. ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM ArchiveM a
act
case Either ArchiveResult a
res of
Right a
x -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
Left ArchiveResult
_ -> FilePath -> IO a
forall a. HasCallStack => FilePath -> a
error FilePath
"Should not fail."
entriesToBSGeneral :: (Foldable t) => (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM BS.ByteString
entriesToBSGeneral :: (Ptr Archive -> IO ArchiveResult) -> t Entry -> ArchiveM ByteString
entriesToBSGeneral Ptr Archive -> IO ArchiveResult
modifier t Entry
hsEntries' = do
Ptr Archive
a <- IO (Ptr Archive) -> ExceptT ArchiveResult IO (Ptr Archive)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr Archive)
archiveWriteNew
IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
modifier Ptr Archive
a
Int -> (Ptr CChar -> ArchiveM ByteString) -> ArchiveM ByteString
forall a b c. Int -> (Ptr a -> ExceptT b IO c) -> ExceptT b IO c
allocaBytesArchiveM Int
forall a. Integral a => a
bufSize ((Ptr CChar -> ArchiveM ByteString) -> ArchiveM ByteString)
-> (Ptr CChar -> ArchiveM ByteString) -> ArchiveM ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buffer -> do
(ArchiveResult
err, CSize
usedSz) <- IO (ArchiveResult, CSize)
-> ExceptT ArchiveResult IO (ArchiveResult, CSize)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ArchiveResult, CSize)
-> ExceptT ArchiveResult IO (ArchiveResult, CSize))
-> IO (ArchiveResult, CSize)
-> ExceptT ArchiveResult IO (ArchiveResult, CSize)
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr CChar -> CSize -> IO (ArchiveResult, CSize)
forall a.
Ptr Archive -> Ptr a -> CSize -> IO (ArchiveResult, CSize)
archiveWriteOpenMemory Ptr Archive
a Ptr CChar
buffer CSize
forall a. Integral a => a
bufSize
IO ArchiveResult -> ArchiveM ()
handle (ArchiveResult -> IO ArchiveResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure ArchiveResult
err)
Ptr Archive -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
Ptr Archive -> t Entry -> ArchiveM ()
packEntries Ptr Archive
a t Entry
hsEntries'
IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
archiveWriteClose Ptr Archive
a
ByteString
res <- IO ByteString -> ArchiveM ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> ArchiveM ByteString)
-> IO ByteString -> ArchiveM ByteString
forall a b. (a -> b) -> a -> b
$ (CStringLen -> IO ByteString) -> Ptr CChar -> Int -> IO ByteString
forall a b c. ((a, b) -> c) -> a -> b -> c
curry CStringLen -> IO ByteString
packCStringLen Ptr CChar
buffer (CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CSize
usedSz)
IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
archiveFree Ptr Archive
a
ByteString -> ArchiveM ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
res
where bufSize :: Integral a => a
bufSize :: a
bufSize = t Entry -> a
forall (t :: * -> *) a. (Foldable t, Integral a) => t Entry -> a
entriesSz t Entry
hsEntries'
filePacker :: (Traversable t) => (FilePath -> t Entry -> ArchiveM ()) -> FilePath -> t FilePath -> ArchiveM ()
filePacker :: (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
f FilePath
tar t FilePath
fps = FilePath -> t Entry -> ArchiveM ()
f FilePath
tar (t Entry -> ArchiveM ())
-> ExceptT ArchiveResult IO (t Entry) -> ArchiveM ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (t Entry) -> ExceptT ArchiveResult IO (t Entry)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((FilePath -> IO Entry) -> t FilePath -> IO (t Entry)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO Entry
mkEntry t FilePath
fps)
packToFile :: Traversable t
=> FilePath
-> t FilePath
-> ArchiveM ()
packToFile :: FilePath -> t FilePath -> ArchiveM ()
packToFile = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFile
packToFileZip :: Traversable t
=> FilePath
-> t FilePath
-> ArchiveM ()
packToFileZip :: FilePath -> t FilePath -> ArchiveM ()
packToFileZip = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFileZip
packToFile7Zip :: Traversable t
=> FilePath
-> t FilePath
-> ArchiveM ()
packToFile7Zip :: FilePath -> t FilePath -> ArchiveM ()
packToFile7Zip = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFile7Zip
packToFileCpio :: Traversable t
=> FilePath
-> t FilePath
-> ArchiveM ()
packToFileCpio :: FilePath -> t FilePath -> ArchiveM ()
packToFileCpio = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFileCpio
packToFileXar :: Traversable t
=> FilePath
-> t FilePath
-> ArchiveM ()
packToFileXar :: FilePath -> t FilePath -> ArchiveM ()
packToFileXar = (FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
forall (t :: * -> *).
Traversable t =>
(FilePath -> t Entry -> ArchiveM ())
-> FilePath -> t FilePath -> ArchiveM ()
filePacker FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
FilePath -> t Entry -> ArchiveM ()
entriesToFileXar
entriesToFile :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFile :: FilePath -> t Entry -> ArchiveM ()
entriesToFile = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatPaxRestricted
entriesToFileZip :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFileZip :: FilePath -> t Entry -> ArchiveM ()
entriesToFileZip = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatZip
entriesToFile7Zip :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFile7Zip :: FilePath -> t Entry -> ArchiveM ()
entriesToFile7Zip = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormat7zip
entriesToFileCpio :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFileCpio :: FilePath -> t Entry -> ArchiveM ()
entriesToFileCpio = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatCpio
entriesToFileXar :: Foldable t => FilePath -> t Entry -> ArchiveM ()
entriesToFileXar :: FilePath -> t Entry -> ArchiveM ()
entriesToFileXar = (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
(Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
archiveWriteSetFormatXar
entriesToFileGeneral :: Foldable t => (Ptr Archive -> IO ArchiveResult) -> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral :: (Ptr Archive -> IO ArchiveResult)
-> FilePath -> t Entry -> ArchiveM ()
entriesToFileGeneral Ptr Archive -> IO ArchiveResult
modifier FilePath
fp t Entry
hsEntries' =
IO (Ptr Archive)
-> (Ptr Archive -> IO ArchiveResult)
-> (Ptr Archive -> ArchiveM ())
-> ArchiveM ()
forall a b c.
IO a -> (a -> IO b) -> (a -> ArchiveM c) -> ArchiveM c
bracketM
IO (Ptr Archive)
archiveWriteNew
Ptr Archive -> IO ArchiveResult
archiveFree
(\Ptr Archive
a -> do
IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO ArchiveResult
modifier Ptr Archive
a
FilePath -> (Ptr CChar -> ArchiveM ()) -> ArchiveM ()
forall a b.
FilePath -> (Ptr CChar -> ExceptT a IO b) -> ExceptT a IO b
withCStringArchiveM FilePath
fp ((Ptr CChar -> ArchiveM ()) -> ArchiveM ())
-> (Ptr CChar -> ArchiveM ()) -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc ->
IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> Ptr CChar -> IO ArchiveResult
archiveWriteOpenFilename Ptr Archive
a Ptr CChar
fpc
Ptr Archive -> t Entry -> ArchiveM ()
forall (t :: * -> *).
Foldable t =>
Ptr Archive -> t Entry -> ArchiveM ()
packEntries Ptr Archive
a t Entry
hsEntries')
withArchiveEntry :: (Ptr ArchiveEntry -> ArchiveM a) -> ArchiveM a
withArchiveEntry :: (Ptr ArchiveEntry -> ArchiveM a) -> ArchiveM a
withArchiveEntry =
IO (Ptr ArchiveEntry)
-> (Ptr ArchiveEntry -> IO ())
-> (Ptr ArchiveEntry -> ArchiveM a)
-> ArchiveM a
forall a b c.
IO a -> (a -> IO b) -> (a -> ArchiveM c) -> ArchiveM c
bracketM
IO (Ptr ArchiveEntry)
archiveEntryNew
Ptr ArchiveEntry -> IO ()
archiveEntryFree
archiveEntryAdd :: Ptr Archive -> Entry -> ArchiveM ()
archiveEntryAdd :: Ptr Archive -> Entry -> ArchiveM ()
archiveEntryAdd Ptr Archive
a (Entry FilePath
fp EntryContent
contents Permissions
perms Ownership
owner Maybe ModTime
mtime) =
(Ptr ArchiveEntry -> ArchiveM ()) -> ArchiveM ()
forall a. (Ptr ArchiveEntry -> ArchiveM a) -> ArchiveM a
withArchiveEntry ((Ptr ArchiveEntry -> ArchiveM ()) -> ArchiveM ())
-> (Ptr ArchiveEntry -> ArchiveM ()) -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ \Ptr ArchiveEntry
entry -> do
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (Ptr CChar -> IO ()) -> IO ()
forall a. FilePath -> (Ptr CChar -> IO a) -> IO a
withCString FilePath
fp ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fpc ->
Ptr ArchiveEntry -> Ptr CChar -> IO ()
archiveEntrySetPathname Ptr ArchiveEntry
entry Ptr CChar
fpc
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ptr ArchiveEntry -> Permissions -> IO ()
archiveEntrySetPerm Ptr ArchiveEntry
entry Permissions
perms
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Ownership -> Ptr ArchiveEntry -> IO ()
setOwnership Ownership
owner Ptr ArchiveEntry
entry
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ArchiveM ()) -> IO () -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ Maybe (IO ()) -> IO ()
forall (f :: * -> *). Applicative f => Maybe (f ()) -> f ()
maybeDo (ModTime -> Ptr ArchiveEntry -> IO ()
setTime (ModTime -> Ptr ArchiveEntry -> IO ())
-> Maybe ModTime -> Maybe (Ptr ArchiveEntry -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ModTime
mtime Maybe (Ptr ArchiveEntry -> IO ())
-> Maybe (Ptr ArchiveEntry) -> Maybe (IO ())
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr ArchiveEntry -> Maybe (Ptr ArchiveEntry)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ArchiveEntry
entry)
EntryContent -> Ptr Archive -> Ptr ArchiveEntry -> ArchiveM ()
contentAdd EntryContent
contents Ptr Archive
a Ptr ArchiveEntry
entry