module Archive.Generic ( packFromDir
                       , unpackFileToDir
                       , unpackFromFile
                       , packToFile
                       , archiveSigVersion
                       , packFromFiles
                       , unpackToDir
                       , packFiles
                       ) where

import           Archive
import           Archive.Compression
import           Control.Composition  ((.@))
import           Control.Exception    (throw)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Version         as V
import qualified Paths_archive_sig    as P


-- | @since 0.2.3.0
archiveSigVersion :: V.Version
archiveSigVersion :: Version
archiveSigVersion = Version
P.version

packFromFiles :: FilePath -- ^ Path of @.tar@ file to write
              -> [FilePath] -- ^ Files and directories to archive
              -> IO ()
packFromFiles :: FilePath -> [FilePath] -> IO ()
packFromFiles = Compressor -> FilePath -> [FilePath] -> IO ()
packFromFilesAndCompress Compressor
forall a. a -> a
id

packToFile :: FilePath -> [Entry] -> IO ()
packToFile :: FilePath -> [Entry] -> IO ()
packToFile = [Entry] -> ByteString
writeArchiveBytes ([Entry] -> ByteString)
-> (FilePath -> ByteString -> IO ())
-> FilePath
-> [Entry]
-> IO ()
forall b c a d. (b -> c) -> (a -> c -> d) -> a -> b -> d
.@ FilePath -> ByteString -> IO ()
BSL.writeFile

unpackFromFile :: FilePath -> IO [Entry]
unpackFromFile :: FilePath -> IO [Entry]
unpackFromFile = (ByteString -> [Entry]) -> IO ByteString -> IO [Entry]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Error -> [Entry])
-> ([Entry] -> [Entry]) -> Either Error [Entry] -> [Entry]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Error -> [Entry]
forall a e. Exception e => e -> a
throw [Entry] -> [Entry]
forall a. a -> a
id (Either Error [Entry] -> [Entry])
-> (ByteString -> Either Error [Entry]) -> ByteString -> [Entry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Error [Entry]
readArchiveBytes) (IO ByteString -> IO [Entry])
-> (FilePath -> IO ByteString) -> FilePath -> IO [Entry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BSL.readFile

unpackFileToDir :: FilePath -- ^ Filepath pointing to archive
                -> FilePath -- ^ Directory
                -> IO ()
unpackFileToDir :: FilePath -> FilePath -> IO ()
unpackFileToDir = Compressor -> FilePath -> FilePath -> IO ()
unpackFileToDirAndDecompress Compressor
forall a. a -> a
id

packFromDir :: FilePath -- ^ Directory to be packed up
            -> FilePath -- ^ @.tar@ archive file
            -> IO ()
packFromDir :: FilePath -> FilePath -> IO ()
packFromDir = Compressor -> FilePath -> FilePath -> IO ()
packFromDirAndCompress Compressor
forall a. a -> a
id