{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Distribution.Client.Tar
(
createTarGzFile,
TarComp.extractTarGzFile,
buildTreeRefTypeCode,
buildTreeSnapshotTypeCode,
isBuildTreeRefTypeCode,
filterEntries,
filterEntriesM,
entriesToList,
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Archive.Tar.Entry as Tar
import qualified Codec.Compression.GZip as GZip
import qualified Data.ByteString.Lazy as BS
import qualified Distribution.Client.Compat.Tar as TarComp
import Control.Exception (throw)
createTarGzFile :: FilePath
-> FilePath
-> FilePath
-> IO ()
createTarGzFile :: FilePath -> FilePath -> FilePath -> IO ()
createTarGzFile FilePath
tar FilePath
base FilePath
dir =
FilePath -> ByteString -> IO ()
BS.writeFile FilePath
tar (ByteString -> IO ())
-> ([Entry] -> ByteString) -> [Entry] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.compress (ByteString -> ByteString)
-> ([Entry] -> ByteString) -> [Entry] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Entry] -> ByteString
Tar.write ([Entry] -> IO ()) -> IO [Entry] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> [FilePath] -> IO [Entry]
Tar.pack FilePath
base [FilePath
dir]
buildTreeRefTypeCode :: Tar.TypeCode
buildTreeRefTypeCode :: TypeCode
buildTreeRefTypeCode = TypeCode
'C'
buildTreeSnapshotTypeCode :: Tar.TypeCode
buildTreeSnapshotTypeCode :: TypeCode
buildTreeSnapshotTypeCode = TypeCode
'S'
isBuildTreeRefTypeCode :: Tar.TypeCode -> Bool
isBuildTreeRefTypeCode :: TypeCode -> Bool
isBuildTreeRefTypeCode TypeCode
typeCode
| (TypeCode
typeCode TypeCode -> TypeCode -> Bool
forall a. Eq a => a -> a -> Bool
== TypeCode
buildTreeRefTypeCode
Bool -> Bool -> Bool
|| TypeCode
typeCode TypeCode -> TypeCode -> Bool
forall a. Eq a => a -> a -> Bool
== TypeCode
buildTreeSnapshotTypeCode) = Bool
True
| Bool
otherwise = Bool
False
filterEntries :: (Tar.Entry -> Bool) -> Tar.Entries e -> Tar.Entries e
filterEntries :: forall e. (Entry -> Bool) -> Entries e -> Entries e
filterEntries Entry -> Bool
p =
(Entry -> Entries e -> Entries e)
-> Entries e -> (e -> Entries e) -> Entries e -> Entries e
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
Tar.foldEntries
(\Entry
e Entries e
es -> if Entry -> Bool
p Entry
e then Entry -> Entries e -> Entries e
forall e. Entry -> Entries e -> Entries e
Tar.Next Entry
e Entries e
es else Entries e
es)
Entries e
forall e. Entries e
Tar.Done
e -> Entries e
forall e. e -> Entries e
Tar.Fail
filterEntriesM :: Monad m => (Tar.Entry -> m Bool)
-> Tar.Entries e -> m (Tar.Entries e)
filterEntriesM :: forall (m :: * -> *) e.
Monad m =>
(Entry -> m Bool) -> Entries e -> m (Entries e)
filterEntriesM Entry -> m Bool
p =
(Entry -> m (Entries e) -> m (Entries e))
-> m (Entries e)
-> (e -> m (Entries e))
-> Entries e
-> m (Entries e)
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
Tar.foldEntries
(\Entry
entry m (Entries e)
rest -> do
Bool
keep <- Entry -> m Bool
p Entry
entry
Entries e
xs <- m (Entries e)
rest
if Bool
keep
then Entries e -> m (Entries e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entry -> Entries e -> Entries e
forall e. Entry -> Entries e -> Entries e
Tar.Next Entry
entry Entries e
xs)
else Entries e -> m (Entries e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Entries e
xs)
(Entries e -> m (Entries e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Entries e
forall e. Entries e
Tar.Done)
(Entries e -> m (Entries e)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Entries e -> m (Entries e))
-> (e -> Entries e) -> e -> m (Entries e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Entries e
forall e. e -> Entries e
Tar.Fail)
entriesToList :: Exception e => Tar.Entries e -> [Tar.Entry]
entriesToList :: forall e. Exception e => Entries e -> [Entry]
entriesToList = (Entry -> [Entry] -> [Entry])
-> [Entry] -> (e -> [Entry]) -> Entries e -> [Entry]
forall a e. (Entry -> a -> a) -> a -> (e -> a) -> Entries e -> a
Tar.foldEntries (:) [] e -> [Entry]
forall a e. Exception e => e -> a
throw