module Codec.Archive.Internal.Unpack ( hsEntriesAbs
, unpackEntriesFp
, unpackArchive
, readArchiveFile
, readArchiveBS
, archiveFile
, bsToArchive
, unpackToDir
, readBS
, readBSL
, readEntry
, readContents
, getHsEntry
, hsEntries
, hsEntriesST
, hsEntriesSTLazy
, hsEntriesSTAbs
) where
import Codec.Archive.Foreign
import Codec.Archive.Internal.Monad
import Codec.Archive.Types
import Control.Monad ((<=<))
import Control.Monad.IO.Class (liftIO)
import qualified Control.Monad.ST.Lazy as LazyST
import qualified Control.Monad.ST.Lazy.Unsafe as LazyST
import Data.Bifunctor (first)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Functor (void, ($>))
import Foreign.C.String
import Foreign.Concurrent (newForeignPtr)
import Foreign.ForeignPtr (castForeignPtr, newForeignPtr_)
import Foreign.Marshal.Alloc (allocaBytes, free, mallocBytes)
import Foreign.Marshal.Utils (copyBytes)
import Foreign.Ptr (castPtr, nullPtr)
import System.FilePath ((</>))
import System.IO.Unsafe (unsafeDupablePerformIO)
readArchiveBS :: BS.ByteString -> Either ArchiveResult [Entry FilePath BS.ByteString]
readArchiveBS :: ByteString -> Either ArchiveResult [Entry FilePath ByteString]
readArchiveBS = IO (Either ArchiveResult [Entry FilePath ByteString])
-> Either ArchiveResult [Entry FilePath ByteString]
forall a. IO a -> a
unsafeDupablePerformIO (IO (Either ArchiveResult [Entry FilePath ByteString])
-> Either ArchiveResult [Entry FilePath ByteString])
-> (ByteString
-> IO (Either ArchiveResult [Entry FilePath ByteString]))
-> ByteString
-> Either ArchiveResult [Entry FilePath ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM [Entry FilePath ByteString]
-> IO (Either ArchiveResult [Entry FilePath ByteString])
forall a. ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM (ArchiveM [Entry FilePath ByteString]
-> IO (Either ArchiveResult [Entry FilePath ByteString]))
-> (ByteString -> ArchiveM [Entry FilePath ByteString])
-> ByteString
-> IO (Either ArchiveResult [Entry FilePath ByteString])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ArchivePtr -> ArchiveM [Entry FilePath ByteString])
-> (ArchivePtr, IO ()) -> ArchiveM [Entry FilePath ByteString]
forall (f :: * -> *) t a b.
MonadIO f =>
(t -> f a) -> (t, IO b) -> f a
go ArchivePtr -> ArchiveM [Entry FilePath ByteString]
hsEntries ((ArchivePtr, IO ()) -> ArchiveM [Entry FilePath ByteString])
-> (ByteString -> ExceptT ArchiveResult IO (ArchivePtr, IO ()))
-> ByteString
-> ArchiveM [Entry FilePath ByteString]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> ExceptT ArchiveResult IO (ArchivePtr, IO ())
bsToArchive)
where go :: (t -> f a) -> (t, IO b) -> f a
go t -> f a
f (t
y, IO b
act) = t -> f a
f t
y f a -> f b -> f a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* IO b -> f b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO b
act
{-# NOINLINE readArchiveBS #-}
bsToArchive :: BS.ByteString -> ArchiveM (ArchivePtr, IO ())
bsToArchive :: ByteString -> ExceptT ArchiveResult IO (ArchivePtr, IO ())
bsToArchive ByteString
bs = do
Ptr Archive
preA <- IO (Ptr Archive) -> ExceptT ArchiveResult IO (Ptr Archive)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr Archive)
archiveReadNew
ArchivePtr
a <- IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr)
-> IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall a b. (a -> b) -> a -> b
$ ForeignPtr Any -> ArchivePtr
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr Any -> ArchivePtr)
-> IO (ForeignPtr Any) -> IO ArchivePtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> IO () -> IO (ForeignPtr Any)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr (Ptr Archive -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Archive
preA) (IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO CInt
archiveFree Ptr Archive
preA)
IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> IO ArchiveResult
archiveReadSupportFormatAll ArchivePtr
a
Ptr CChar
bufPtr <- ByteString
-> (CStringLen -> ExceptT ArchiveResult IO (Ptr CChar))
-> ExceptT ArchiveResult IO (Ptr CChar)
forall a b.
ByteString -> (CStringLen -> ExceptT a IO b) -> ExceptT a IO b
useAsCStringLenArchiveM ByteString
bs ((CStringLen -> ExceptT ArchiveResult IO (Ptr CChar))
-> ExceptT ArchiveResult IO (Ptr CChar))
-> (CStringLen -> ExceptT ArchiveResult IO (Ptr CChar))
-> ExceptT ArchiveResult IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$
\(Ptr CChar
buf, Int
sz) -> do
Ptr CChar
buf' <- IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar))
-> IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr CChar)
forall a. Int -> IO (Ptr a)
mallocBytes 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
$ Ptr CChar -> Ptr CChar -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CChar
buf' Ptr CChar
buf Int
sz
IO ArchiveResult -> ArchiveM ()
handle (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> Ptr CChar -> CSize -> IO ArchiveResult
forall a. ArchivePtr -> Ptr a -> CSize -> IO ArchiveResult
archiveReadOpenMemory ArchivePtr
a Ptr CChar
buf (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)
Ptr CChar -> ExceptT ArchiveResult IO (Ptr CChar)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr CChar
buf'
(ArchivePtr, IO ()) -> ExceptT ArchiveResult IO (ArchivePtr, IO ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ArchivePtr
a, Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
free Ptr CChar
bufPtr)
readArchiveFile :: FilePath -> ArchiveM [Entry FilePath BS.ByteString]
readArchiveFile :: FilePath -> ArchiveM [Entry FilePath ByteString]
readArchiveFile FilePath
fp = ArchivePtr -> ArchiveM [Entry FilePath ByteString]
act (ArchivePtr -> ArchiveM [Entry FilePath ByteString])
-> ExceptT ArchiveResult IO ArchivePtr
-> ArchiveM [Entry FilePath ByteString]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (do
Ptr Archive
pre <- IO (Ptr Archive)
archiveReadNew
ForeignPtr Any -> ArchivePtr
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr Any -> ArchivePtr)
-> IO (ForeignPtr Any) -> IO ArchivePtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> IO () -> IO (ForeignPtr Any)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr (Ptr Archive -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Archive
pre) (IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO CInt
archiveFree Ptr Archive
pre))
where act :: ArchivePtr -> ArchiveM [Entry FilePath ByteString]
act ArchivePtr
a =
FilePath -> ArchivePtr -> ArchiveM ()
archiveFile FilePath
fp ArchivePtr
a ArchiveM ()
-> [Entry FilePath ByteString]
-> ArchiveM [Entry FilePath ByteString]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (forall s. ST s [Entry FilePath ByteString])
-> [Entry FilePath ByteString]
forall a. (forall s. ST s a) -> a
LazyST.runST (ArchivePtr -> ST s [Entry FilePath ByteString]
forall s. ArchivePtr -> ST s [Entry FilePath ByteString]
hsEntriesST ArchivePtr
a)
{-# INLINE archiveAbs #-}
archiveAbs :: (ArchivePtr -> IO ArchiveResult)
-> FilePath
-> ArchivePtr
-> ArchiveM ()
archiveAbs :: (ArchivePtr -> IO ArchiveResult)
-> FilePath -> ArchivePtr -> ArchiveM ()
archiveAbs ArchivePtr -> IO ArchiveResult
support FilePath
fp ArchivePtr
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
cpath ->
IO ArchiveResult -> ArchiveM ()
ignore (ArchivePtr -> IO ArchiveResult
support ArchivePtr
a) ArchiveM () -> ArchiveM () -> ArchiveM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
IO ArchiveResult -> ArchiveM ()
handle (ArchivePtr -> Ptr CChar -> CSize -> IO ArchiveResult
archiveReadOpenFilename ArchivePtr
a Ptr CChar
cpath CSize
10240)
archiveFile :: FilePath -> ArchivePtr -> ArchiveM ()
archiveFile :: FilePath -> ArchivePtr -> ArchiveM ()
archiveFile = (ArchivePtr -> IO ArchiveResult)
-> FilePath -> ArchivePtr -> ArchiveM ()
archiveAbs ArchivePtr -> IO ArchiveResult
archiveReadSupportFormatAll
unpackArchive :: FilePath
-> FilePath
-> ArchiveM ()
unpackArchive :: FilePath -> FilePath -> ArchiveM ()
unpackArchive FilePath
tarFp FilePath
dirFp = do
Ptr Archive
preA <- IO (Ptr Archive) -> ExceptT ArchiveResult IO (Ptr Archive)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Ptr Archive)
archiveReadNew
ArchivePtr
a <- IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr)
-> IO ArchivePtr -> ExceptT ArchiveResult IO ArchivePtr
forall a b. (a -> b) -> a -> b
$ ForeignPtr Any -> ArchivePtr
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr Any -> ArchivePtr)
-> IO (ForeignPtr Any) -> IO ArchivePtr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> IO () -> IO (ForeignPtr Any)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
newForeignPtr (Ptr Archive -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr Archive
preA) (IO CInt -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Archive -> IO CInt
archiveFree Ptr Archive
preA)
ArchivePtr -> ArchiveM ()
act ArchivePtr
a
where act :: ArchivePtr -> ArchiveM ()
act ArchivePtr
a =
FilePath -> ArchivePtr -> ArchiveM ()
archiveFile FilePath
tarFp ArchivePtr
a ArchiveM () -> ArchiveM () -> ArchiveM ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
ArchivePtr -> FilePath -> ArchiveM ()
unpackEntriesFp ArchivePtr
a FilePath
dirFp
readEntry :: Integral a
=> (ArchivePtr -> a -> IO e)
-> ArchivePtr
-> ArchiveEntryPtr
-> IO (Entry FilePath e)
readEntry :: (ArchivePtr -> a -> IO e)
-> ArchivePtr -> ArchiveEntryPtr -> IO (Entry FilePath e)
readEntry ArchivePtr -> a -> IO e
read' ArchivePtr
a ArchiveEntryPtr
entry =
FilePath
-> EntryContent FilePath e
-> Permissions
-> Ownership
-> Maybe ModTime
-> Entry FilePath e
forall fp e.
fp
-> EntryContent fp e
-> Permissions
-> Ownership
-> Maybe ModTime
-> Entry fp e
Entry
(FilePath
-> EntryContent FilePath e
-> Permissions
-> Ownership
-> Maybe ModTime
-> Entry FilePath e)
-> IO FilePath
-> IO
(EntryContent FilePath e
-> Permissions -> Ownership -> Maybe ModTime -> Entry FilePath e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO FilePath
peekCString (Ptr CChar -> IO FilePath) -> IO (Ptr CChar) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArchiveEntryPtr -> IO (Ptr CChar)
archiveEntryPathname ArchiveEntryPtr
entry)
IO
(EntryContent FilePath e
-> Permissions -> Ownership -> Maybe ModTime -> Entry FilePath e)
-> IO (EntryContent FilePath e)
-> IO
(Permissions -> Ownership -> Maybe ModTime -> Entry FilePath e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ArchivePtr -> a -> IO e)
-> ArchivePtr -> ArchiveEntryPtr -> IO (EntryContent FilePath e)
forall a e.
Integral a =>
(ArchivePtr -> a -> IO e)
-> ArchivePtr -> ArchiveEntryPtr -> IO (EntryContent FilePath e)
readContents ArchivePtr -> a -> IO e
read' ArchivePtr
a ArchiveEntryPtr
entry
IO (Permissions -> Ownership -> Maybe ModTime -> Entry FilePath e)
-> IO Permissions
-> IO (Ownership -> Maybe ModTime -> Entry FilePath e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ArchiveEntryPtr -> IO Permissions
archiveEntryPerm ArchiveEntryPtr
entry
IO (Ownership -> Maybe ModTime -> Entry FilePath e)
-> IO Ownership -> IO (Maybe ModTime -> Entry FilePath e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ArchiveEntryPtr -> IO Ownership
readOwnership ArchiveEntryPtr
entry
IO (Maybe ModTime -> Entry FilePath e)
-> IO (Maybe ModTime) -> IO (Entry FilePath e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ArchiveEntryPtr -> IO (Maybe ModTime)
readTimes ArchiveEntryPtr
entry
getHsEntry :: Integral a
=> (ArchivePtr -> a -> IO e)
-> ArchivePtr
-> IO (Maybe (Entry FilePath e))
getHsEntry :: (ArchivePtr -> a -> IO e)
-> ArchivePtr -> IO (Maybe (Entry FilePath e))
getHsEntry ArchivePtr -> a -> IO e
read' ArchivePtr
a = do
Maybe ArchiveEntryPtr
entry <- ArchivePtr -> IO (Maybe ArchiveEntryPtr)
getEntry ArchivePtr
a
case Maybe ArchiveEntryPtr
entry of
Maybe ArchiveEntryPtr
Nothing -> Maybe (Entry FilePath e) -> IO (Maybe (Entry FilePath e))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Entry FilePath e)
forall a. Maybe a
Nothing
Just ArchiveEntryPtr
x -> Entry FilePath e -> Maybe (Entry FilePath e)
forall a. a -> Maybe a
Just (Entry FilePath e -> Maybe (Entry FilePath e))
-> IO (Entry FilePath e) -> IO (Maybe (Entry FilePath e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArchivePtr -> a -> IO e)
-> ArchivePtr -> ArchiveEntryPtr -> IO (Entry FilePath e)
forall a e.
Integral a =>
(ArchivePtr -> a -> IO e)
-> ArchivePtr -> ArchiveEntryPtr -> IO (Entry FilePath e)
readEntry ArchivePtr -> a -> IO e
read' ArchivePtr
a ArchiveEntryPtr
x
hsEntries :: ArchivePtr -> ArchiveM [Entry FilePath BS.ByteString]
hsEntries :: ArchivePtr -> ArchiveM [Entry FilePath ByteString]
hsEntries = (ArchivePtr -> Int -> IO ByteString)
-> ArchivePtr -> ArchiveM [Entry FilePath ByteString]
forall a e.
Integral a =>
(ArchivePtr -> a -> IO e)
-> ArchivePtr -> ArchiveM [Entry FilePath e]
hsEntriesAbs ArchivePtr -> Int -> IO ByteString
readBS
hsEntriesAbs :: Integral a
=> (ArchivePtr -> a -> IO e)
-> ArchivePtr
-> ArchiveM [Entry FilePath e]
hsEntriesAbs :: (ArchivePtr -> a -> IO e)
-> ArchivePtr -> ArchiveM [Entry FilePath e]
hsEntriesAbs ArchivePtr -> a -> IO e
read' ArchivePtr
p = [Entry FilePath e] -> ArchiveM [Entry FilePath e]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((forall s. ST s [Entry FilePath e]) -> [Entry FilePath e]
forall a. (forall s. ST s a) -> a
LazyST.runST ((forall s. ST s [Entry FilePath e]) -> [Entry FilePath e])
-> (forall s. ST s [Entry FilePath e]) -> [Entry FilePath e]
forall a b. (a -> b) -> a -> b
$ (ArchivePtr -> a -> IO e) -> ArchivePtr -> ST s [Entry FilePath e]
forall a e s.
Integral a =>
(ArchivePtr -> a -> IO e) -> ArchivePtr -> ST s [Entry FilePath e]
hsEntriesSTAbs ArchivePtr -> a -> IO e
read' ArchivePtr
p)
hsEntriesST :: ArchivePtr -> LazyST.ST s [Entry FilePath BS.ByteString]
hsEntriesST :: ArchivePtr -> ST s [Entry FilePath ByteString]
hsEntriesST = (ArchivePtr -> Int -> IO ByteString)
-> ArchivePtr -> ST s [Entry FilePath ByteString]
forall a e s.
Integral a =>
(ArchivePtr -> a -> IO e) -> ArchivePtr -> ST s [Entry FilePath e]
hsEntriesSTAbs ArchivePtr -> Int -> IO ByteString
readBS
hsEntriesSTLazy :: ArchivePtr -> LazyST.ST s [Entry FilePath BSL.ByteString]
hsEntriesSTLazy :: ArchivePtr -> ST s [Entry FilePath ByteString]
hsEntriesSTLazy = (ArchivePtr -> Int -> IO ByteString)
-> ArchivePtr -> ST s [Entry FilePath ByteString]
forall a e s.
Integral a =>
(ArchivePtr -> a -> IO e) -> ArchivePtr -> ST s [Entry FilePath e]
hsEntriesSTAbs ArchivePtr -> Int -> IO ByteString
readBSL
hsEntriesSTAbs :: Integral a
=> (ArchivePtr -> a -> IO e)
-> ArchivePtr
-> LazyST.ST s [Entry FilePath e]
hsEntriesSTAbs :: (ArchivePtr -> a -> IO e) -> ArchivePtr -> ST s [Entry FilePath e]
hsEntriesSTAbs ArchivePtr -> a -> IO e
read' ArchivePtr
a = do
Maybe (Entry FilePath e)
next <- IO (Maybe (Entry FilePath e)) -> ST s (Maybe (Entry FilePath e))
forall a s. IO a -> ST s a
LazyST.unsafeIOToST ((ArchivePtr -> a -> IO e)
-> ArchivePtr -> IO (Maybe (Entry FilePath e))
forall a e.
Integral a =>
(ArchivePtr -> a -> IO e)
-> ArchivePtr -> IO (Maybe (Entry FilePath e))
getHsEntry ArchivePtr -> a -> IO e
read' ArchivePtr
a)
case Maybe (Entry FilePath e)
next of
Maybe (Entry FilePath e)
Nothing -> [Entry FilePath e] -> ST s [Entry FilePath e]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just Entry FilePath e
x -> (Entry FilePath e
xEntry FilePath e -> [Entry FilePath e] -> [Entry FilePath e]
forall a. a -> [a] -> [a]
:) ([Entry FilePath e] -> [Entry FilePath e])
-> ST s [Entry FilePath e] -> ST s [Entry FilePath e]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArchivePtr -> a -> IO e) -> ArchivePtr -> ST s [Entry FilePath e]
forall a e s.
Integral a =>
(ArchivePtr -> a -> IO e) -> ArchivePtr -> ST s [Entry FilePath e]
hsEntriesSTAbs ArchivePtr -> a -> IO e
read' ArchivePtr
a
unpackEntriesFp :: ArchivePtr -> FilePath -> ArchiveM ()
unpackEntriesFp :: ArchivePtr -> FilePath -> ArchiveM ()
unpackEntriesFp ArchivePtr
a FilePath
fp = do
Maybe ArchiveEntryPtr
res <- IO (Maybe ArchiveEntryPtr)
-> ExceptT ArchiveResult IO (Maybe ArchiveEntryPtr)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ArchiveEntryPtr)
-> ExceptT ArchiveResult IO (Maybe ArchiveEntryPtr))
-> IO (Maybe ArchiveEntryPtr)
-> ExceptT ArchiveResult IO (Maybe ArchiveEntryPtr)
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> IO (Maybe ArchiveEntryPtr)
getEntry ArchivePtr
a
case Maybe ArchiveEntryPtr
res of
Maybe ArchiveEntryPtr
Nothing -> () -> ArchiveM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ArchiveEntryPtr
x -> do
Ptr CChar
preFile <- IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar))
-> IO (Ptr CChar) -> ExceptT ArchiveResult IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ ArchiveEntryPtr -> IO (Ptr CChar)
archiveEntryPathname ArchiveEntryPtr
x
FilePath
file <- IO FilePath -> ExceptT ArchiveResult IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ExceptT ArchiveResult IO FilePath)
-> IO FilePath -> ExceptT ArchiveResult IO FilePath
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO FilePath
peekCString Ptr CChar
preFile
let file' :: FilePath
file' = FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
file
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
file' ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
fileC ->
ArchiveEntryPtr -> Ptr CChar -> IO ()
archiveEntrySetPathname ArchiveEntryPtr
x Ptr CChar
fileC
Maybe FileType
ft <- IO (Maybe FileType) -> ExceptT ArchiveResult IO (Maybe FileType)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FileType) -> ExceptT ArchiveResult IO (Maybe FileType))
-> IO (Maybe FileType) -> ExceptT ArchiveResult IO (Maybe FileType)
forall a b. (a -> b) -> a -> b
$ ArchiveEntryPtr -> IO (Maybe FileType)
archiveEntryFiletype ArchiveEntryPtr
x
case Maybe FileType
ft of
Just{} ->
IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> ArchiveEntryPtr -> Flags -> IO ArchiveResult
archiveReadExtract ArchivePtr
a ArchiveEntryPtr
x Flags
archiveExtractTime
Maybe FileType
Nothing -> do
FilePath
hardlink <- IO FilePath -> ExceptT ArchiveResult IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> ExceptT ArchiveResult IO FilePath)
-> IO FilePath -> ExceptT ArchiveResult IO FilePath
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO FilePath
peekCString (Ptr CChar -> IO FilePath) -> IO (Ptr CChar) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArchiveEntryPtr -> IO (Ptr CChar)
archiveEntryHardlink ArchiveEntryPtr
x
let hardlink' :: FilePath
hardlink' = FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
hardlink
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
hardlink' ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
hl ->
ArchiveEntryPtr -> Ptr CChar -> IO ()
archiveEntrySetHardlink ArchiveEntryPtr
x Ptr CChar
hl
IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> ArchiveEntryPtr -> Flags -> IO ArchiveResult
archiveReadExtract ArchivePtr
a ArchiveEntryPtr
x Flags
archiveExtractTime
IO ArchiveResult -> ArchiveM ()
ignore (IO ArchiveResult -> ArchiveM ())
-> IO ArchiveResult -> ArchiveM ()
forall a b. (a -> b) -> a -> b
$ ArchivePtr -> IO ArchiveResult
archiveReadDataSkip ArchivePtr
a
ArchivePtr -> FilePath -> ArchiveM ()
unpackEntriesFp ArchivePtr
a FilePath
fp
{-# INLINE readBS #-}
readBS :: ArchivePtr -> Int -> IO BS.ByteString
readBS :: ArchivePtr -> Int -> IO ByteString
readBS ArchivePtr
a Int
sz =
Int -> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
sz ((Ptr CChar -> IO ByteString) -> IO ByteString)
-> (Ptr CChar -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
buff ->
ArchivePtr -> Ptr CChar -> CSize -> IO LaSSize
forall a. ArchivePtr -> Ptr a -> CSize -> IO LaSSize
archiveReadData ArchivePtr
a Ptr CChar
buff (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz) IO LaSSize -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
buff, Int
sz)
readBSL :: ArchivePtr -> Int -> IO BSL.ByteString
readBSL :: ArchivePtr -> Int -> IO ByteString
readBSL ArchivePtr
a Int
_ = [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
loop
where step :: IO (Maybe ByteString)
step =
Int
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufSz ((Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr CChar -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
bufPtr -> do
LaSSize
bRead <- ArchivePtr -> Ptr CChar -> CSize -> IO LaSSize
forall a. ArchivePtr -> Ptr a -> CSize -> IO LaSSize
archiveReadData ArchivePtr
a Ptr CChar
bufPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bufSz)
if LaSSize
bRead LaSSize -> LaSSize -> Bool
forall a. Eq a => a -> a -> Bool
== LaSSize
0
then Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing
else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO ByteString
BS.packCStringLen (Ptr CChar
bufPtr, LaSSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral LaSSize
bRead)
loop :: IO [ByteString]
loop = do
Maybe ByteString
res <- IO (Maybe ByteString)
step
case Maybe ByteString
res of
Just ByteString
b -> (ByteString
bByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> IO [ByteString] -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString]
loop
Maybe ByteString
Nothing -> [ByteString] -> IO [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
bufSz :: Int
bufSz = Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
readContents :: Integral a
=> (ArchivePtr -> a -> IO e)
-> ArchivePtr
-> ArchiveEntryPtr
-> IO (EntryContent FilePath e)
readContents :: (ArchivePtr -> a -> IO e)
-> ArchivePtr -> ArchiveEntryPtr -> IO (EntryContent FilePath e)
readContents ArchivePtr -> a -> IO e
read' ArchivePtr
a ArchiveEntryPtr
entry = Maybe FileType -> IO (EntryContent FilePath e)
go (Maybe FileType -> IO (EntryContent FilePath e))
-> IO (Maybe FileType) -> IO (EntryContent FilePath e)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArchiveEntryPtr -> IO (Maybe FileType)
archiveEntryFiletype ArchiveEntryPtr
entry
where go :: Maybe FileType -> IO (EntryContent FilePath e)
go Maybe FileType
Nothing = FilePath -> EntryContent FilePath e
forall fp e. fp -> EntryContent fp e
Hardlink (FilePath -> EntryContent FilePath e)
-> IO FilePath -> IO (EntryContent FilePath e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO FilePath
peekCString (Ptr CChar -> IO FilePath) -> IO (Ptr CChar) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArchiveEntryPtr -> IO (Ptr CChar)
archiveEntryHardlink ArchiveEntryPtr
entry)
go (Just FileType
FtRegular) = e -> EntryContent FilePath e
forall fp e. e -> EntryContent fp e
NormalFile (e -> EntryContent FilePath e)
-> IO e -> IO (EntryContent FilePath e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArchivePtr -> a -> IO e
read' ArchivePtr
a (a -> IO e) -> IO a -> IO e
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO a
sz)
go (Just FileType
FtLink) = FilePath -> Symlink -> EntryContent FilePath e
forall fp e. fp -> Symlink -> EntryContent fp e
Symlink (FilePath -> Symlink -> EntryContent FilePath e)
-> IO FilePath -> IO (Symlink -> EntryContent FilePath e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> IO FilePath
peekCString (Ptr CChar -> IO FilePath) -> IO (Ptr CChar) -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArchiveEntryPtr -> IO (Ptr CChar)
archiveEntrySymlink ArchiveEntryPtr
entry) IO (Symlink -> EntryContent FilePath e)
-> IO Symlink -> IO (EntryContent FilePath e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ArchiveEntryPtr -> IO Symlink
archiveEntrySymlinkType ArchiveEntryPtr
entry
go (Just FileType
FtDirectory) = EntryContent FilePath e -> IO (EntryContent FilePath e)
forall (f :: * -> *) a. Applicative f => a -> f a
pure EntryContent FilePath e
forall fp e. EntryContent fp e
Directory
go (Just FileType
_) = FilePath -> IO (EntryContent FilePath e)
forall a. HasCallStack => FilePath -> a
error FilePath
"Unsupported filetype"
sz :: IO a
sz = LaSSize -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LaSSize -> a) -> IO LaSSize -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArchiveEntryPtr -> IO LaSSize
archiveEntrySize ArchiveEntryPtr
entry
archiveGetterHelper :: (ArchiveEntryPtr -> IO a) -> (ArchiveEntryPtr -> IO Bool) -> ArchiveEntryPtr -> IO (Maybe a)
archiveGetterHelper :: (ArchiveEntryPtr -> IO a)
-> (ArchiveEntryPtr -> IO Bool) -> ArchiveEntryPtr -> IO (Maybe a)
archiveGetterHelper ArchiveEntryPtr -> IO a
get ArchiveEntryPtr -> IO Bool
check ArchiveEntryPtr
entry = do
Bool
check' <- ArchiveEntryPtr -> IO Bool
check ArchiveEntryPtr
entry
if Bool
check'
then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArchiveEntryPtr -> IO a
get ArchiveEntryPtr
entry
else Maybe a -> IO (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
archiveGetterNull :: (ArchiveEntryPtr -> IO CString) -> ArchiveEntryPtr -> IO (Maybe String)
archiveGetterNull :: (ArchiveEntryPtr -> IO (Ptr CChar))
-> ArchiveEntryPtr -> IO (Maybe FilePath)
archiveGetterNull ArchiveEntryPtr -> IO (Ptr CChar)
get ArchiveEntryPtr
entry = do
Ptr CChar
res <- ArchiveEntryPtr -> IO (Ptr CChar)
get ArchiveEntryPtr
entry
if Ptr CChar
res Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
then Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
else (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Ptr CChar -> IO FilePath
peekCString Ptr CChar
res)
readOwnership :: ArchiveEntryPtr -> IO Ownership
readOwnership :: ArchiveEntryPtr -> IO Ownership
readOwnership ArchiveEntryPtr
entry =
Maybe FilePath -> Maybe FilePath -> Id -> Id -> Ownership
Ownership
(Maybe FilePath -> Maybe FilePath -> Id -> Id -> Ownership)
-> IO (Maybe FilePath)
-> IO (Maybe FilePath -> Id -> Id -> Ownership)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ArchiveEntryPtr -> IO (Ptr CChar))
-> ArchiveEntryPtr -> IO (Maybe FilePath)
archiveGetterNull ArchiveEntryPtr -> IO (Ptr CChar)
archiveEntryUname ArchiveEntryPtr
entry
IO (Maybe FilePath -> Id -> Id -> Ownership)
-> IO (Maybe FilePath) -> IO (Id -> Id -> Ownership)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ArchiveEntryPtr -> IO (Ptr CChar))
-> ArchiveEntryPtr -> IO (Maybe FilePath)
archiveGetterNull ArchiveEntryPtr -> IO (Ptr CChar)
archiveEntryGname ArchiveEntryPtr
entry
IO (Id -> Id -> Ownership) -> IO Id -> IO (Id -> Ownership)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LaSSize -> Id
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LaSSize -> Id) -> IO LaSSize -> IO Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArchiveEntryPtr -> IO LaSSize
archiveEntryUid ArchiveEntryPtr
entry)
IO (Id -> Ownership) -> IO Id -> IO Ownership
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (LaSSize -> Id
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LaSSize -> Id) -> IO LaSSize -> IO Id
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArchiveEntryPtr -> IO LaSSize
archiveEntryGid ArchiveEntryPtr
entry)
readTimes :: ArchiveEntryPtr -> IO (Maybe ModTime)
readTimes :: ArchiveEntryPtr -> IO (Maybe ModTime)
readTimes = (ArchiveEntryPtr -> IO ModTime)
-> (ArchiveEntryPtr -> IO Bool)
-> ArchiveEntryPtr
-> IO (Maybe ModTime)
forall a.
(ArchiveEntryPtr -> IO a)
-> (ArchiveEntryPtr -> IO Bool) -> ArchiveEntryPtr -> IO (Maybe a)
archiveGetterHelper ArchiveEntryPtr -> IO ModTime
go ArchiveEntryPtr -> IO Bool
archiveEntryMtimeIsSet
where go :: ArchiveEntryPtr -> IO ModTime
go ArchiveEntryPtr
entry =
(,) (CTime -> LaSSize -> ModTime)
-> IO CTime -> IO (LaSSize -> ModTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArchiveEntryPtr -> IO CTime
archiveEntryMtime ArchiveEntryPtr
entry IO (LaSSize -> ModTime) -> IO LaSSize -> IO ModTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ArchiveEntryPtr -> IO LaSSize
archiveEntryMtimeNsec ArchiveEntryPtr
entry
getEntry :: ArchivePtr -> IO (Maybe ArchiveEntryPtr)
getEntry :: ArchivePtr -> IO (Maybe ArchiveEntryPtr)
getEntry ArchivePtr
a = do
let done :: ArchiveResult -> Bool
done ArchiveResult
ArchiveOk = Bool
False
done ArchiveResult
ArchiveRetry = Bool
False
done ArchiveResult
_ = Bool
True
(Bool
stop, Ptr ArchiveEntry
res) <- (ArchiveResult -> Bool)
-> (ArchiveResult, Ptr ArchiveEntry) -> (Bool, Ptr ArchiveEntry)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ArchiveResult -> Bool
done ((ArchiveResult, Ptr ArchiveEntry) -> (Bool, Ptr ArchiveEntry))
-> IO (ArchiveResult, Ptr ArchiveEntry)
-> IO (Bool, Ptr ArchiveEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ArchivePtr -> IO (ArchiveResult, Ptr ArchiveEntry)
archiveReadNextHeader ArchivePtr
a
if Bool
stop
then Maybe ArchiveEntryPtr -> IO (Maybe ArchiveEntryPtr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ArchiveEntryPtr
forall a. Maybe a
Nothing
else ArchiveEntryPtr -> Maybe ArchiveEntryPtr
forall a. a -> Maybe a
Just (ArchiveEntryPtr -> Maybe ArchiveEntryPtr)
-> (ForeignPtr Any -> ArchiveEntryPtr)
-> ForeignPtr Any
-> Maybe ArchiveEntryPtr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr Any -> ArchiveEntryPtr
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr (ForeignPtr Any -> Maybe ArchiveEntryPtr)
-> IO (ForeignPtr Any) -> IO (Maybe ArchiveEntryPtr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> IO (ForeignPtr Any)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ (Ptr ArchiveEntry -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr ArchiveEntry
res)
unpackToDir :: FilePath
-> BS.ByteString
-> ArchiveM ()
unpackToDir :: FilePath -> ByteString -> ArchiveM ()
unpackToDir FilePath
fp ByteString
bs = do
(ArchivePtr
a, IO ()
act) <- ByteString -> ExceptT ArchiveResult IO (ArchivePtr, IO ())
bsToArchive ByteString
bs
ArchivePtr -> FilePath -> ArchiveM ()
unpackEntriesFp ArchivePtr
a FilePath
fp
IO () -> ArchiveM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
act