module Development.Shake.BinDist ( -- * Rules
                                   tarLzip
                                 , tarZstd
                                 , tarBz2
                                 , tarGz
                                 , tarXz
                                   -- * Actions
                                 , tarLzipA
                                 , tarZstdA
                                 , tarBz2A
                                 , tarGzA
                                 , tarXzA
                                 ) where

import           Archive.Compression         (packFromFilesAndCompress)
import qualified Codec.Compression.BZip      as Bz2
import qualified Codec.Compression.GZip      as GZip
import qualified Codec.Compression.Lzma      as Lzma
import qualified Codec.Compression.Zstd.Lazy as Zstd
import qualified Codec.Lzip                  as Lzip
import qualified Data.ByteString.Lazy        as BSL
import           Development.Shake           hiding (action)
import           System.IO                   (IOMode (ReadMode), hFileSize,
                                              withFile)

fileSize :: FilePath -> IO Integer
fileSize :: FilePath -> IO Integer
fileSize FilePath
fp = FilePath -> IOMode -> (Handle -> IO Integer) -> IO Integer
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withFile FilePath
fp IOMode
ReadMode Handle -> IO Integer
hFileSize

tarGenericA :: String -- ^ Rule name
            -> (BSL.ByteString -> BSL.ByteString) -- ^ Compression function
            -> [FilePath] -- ^ Files to pack up
            -> FilePath -- ^ File name of resultant tarball
            -> Action ()
tarGenericA :: FilePath
-> (ByteString -> ByteString)
-> [FilePath]
-> FilePath
-> Action ()
tarGenericA FilePath
rn ByteString -> ByteString
f [FilePath]
fps FilePath
tar = do
    Partial => [FilePath] -> Action ()
[FilePath] -> Action ()
need [FilePath]
fps
    FilePath -> IO () -> Action ()
forall a. FilePath -> IO a -> Action a
traced FilePath
rn (IO () -> Action ()) -> IO () -> Action ()
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> FilePath -> [FilePath] -> IO ()
packFromFilesAndCompress ByteString -> ByteString
f FilePath
tar [FilePath]
fps

mkRule :: (a -> FilePath -> Action ()) -> a -> FilePattern -> Rules ()
mkRule :: (a -> FilePath -> Action ()) -> a -> FilePath -> Rules ()
mkRule a -> FilePath -> Action ()
action a
x FilePath
pat =
    FilePath
pat Partial => FilePath -> (FilePath -> Action ()) -> Rules ()
FilePath -> (FilePath -> Action ()) -> Rules ()
%> \FilePath
out ->
        a -> FilePath -> Action ()
action a
x FilePath
out

-- | The [lzip](http://www.nongnu.org/lzip/lzip.html) format is suitable for
-- archiving.
tarLzip :: [FilePath] -- ^ Files to pack up
        -> FilePattern -- ^ Resultant tarball
        -> Rules ()
tarLzip :: [FilePath] -> FilePath -> Rules ()
tarLzip = ([FilePath] -> FilePath -> Action ())
-> [FilePath] -> FilePath -> Rules ()
forall a. (a -> FilePath -> Action ()) -> a -> FilePath -> Rules ()
mkRule [FilePath] -> FilePath -> Action ()
tarLzipA

tarZstd :: [FilePath] -- ^ Files to pack up
        -> FilePattern -- ^ Resultant tarball
        -> Rules ()
tarZstd :: [FilePath] -> FilePath -> Rules ()
tarZstd = ([FilePath] -> FilePath -> Action ())
-> [FilePath] -> FilePath -> Rules ()
forall a. (a -> FilePath -> Action ()) -> a -> FilePath -> Rules ()
mkRule [FilePath] -> FilePath -> Action ()
tarZstdA

tarGz :: [FilePath] -- ^ Files to pack up
      -> FilePattern -- ^ Resultant tarball
      -> Rules ()
tarGz :: [FilePath] -> FilePath -> Rules ()
tarGz = ([FilePath] -> FilePath -> Action ())
-> [FilePath] -> FilePath -> Rules ()
forall a. (a -> FilePath -> Action ()) -> a -> FilePath -> Rules ()
mkRule [FilePath] -> FilePath -> Action ()
tarGzA

tarBz2 :: [FilePath] -- ^ Files to pack up
      -> FilePattern -- ^ Resultant tarball
      -> Rules ()
tarBz2 :: [FilePath] -> FilePath -> Rules ()
tarBz2 = ([FilePath] -> FilePath -> Action ())
-> [FilePath] -> FilePath -> Rules ()
forall a. (a -> FilePath -> Action ()) -> a -> FilePath -> Rules ()
mkRule [FilePath] -> FilePath -> Action ()
tarBz2A

-- | @since 1.0.1.0
tarXz :: [FilePath] -- ^ Files to pack up
      -> FilePattern -- ^ Resultant tarball
      -> Rules ()
tarXz :: [FilePath] -> FilePath -> Rules ()
tarXz = ([FilePath] -> FilePath -> Action ())
-> [FilePath] -> FilePath -> Rules ()
forall a. (a -> FilePath -> Action ()) -> a -> FilePath -> Rules ()
mkRule [FilePath] -> FilePath -> Action ()
tarXzA

tarLzipA :: [FilePath] -- ^ Files to pack up
         -> FilePath -- ^ File name of resultant tarball
         -> Action ()
tarLzipA :: [FilePath] -> FilePath -> Action ()
tarLzipA [FilePath]
fps FilePath
tar = do
    Int
guessSz <- IO Int -> Action Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> IO [Int] -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO Int) -> [FilePath] -> IO [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Integer -> Int) -> IO Integer -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Integer -> IO Int)
-> (FilePath -> IO Integer) -> FilePath -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Integer
fileSize) [FilePath]
fps)
    FilePath
-> (ByteString -> ByteString)
-> [FilePath]
-> FilePath
-> Action ()
tarGenericA FilePath
"tar-lzip" ((ByteString -> Int -> ByteString)
-> Int -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Int -> ByteString
Lzip.compressSzBest Int
guessSz) [FilePath]
fps FilePath
tar

tarZstdA :: [FilePath] -- ^ Files to pack up
         -> FilePath -- ^ File name of resultant tarball
         -> Action ()
tarZstdA :: [FilePath] -> FilePath -> Action ()
tarZstdA = FilePath
-> (ByteString -> ByteString)
-> [FilePath]
-> FilePath
-> Action ()
tarGenericA FilePath
"tar-zstd" (Int -> ByteString -> ByteString
Zstd.compress Int
Zstd.maxCLevel)

tarGzA :: [FilePath] -- ^ Files to pack up
       -> FilePath -- ^ File name of resultant tarball
       -> Action ()
tarGzA :: [FilePath] -> FilePath -> Action ()
tarGzA = FilePath
-> (ByteString -> ByteString)
-> [FilePath]
-> FilePath
-> Action ()
tarGenericA FilePath
"tar-gz" ByteString -> ByteString
GZip.compress

tarBz2A :: [FilePath] -- ^ Files to pack up
        -> FilePath -- ^ File name of resultant tarball
        -> Action ()
tarBz2A :: [FilePath] -> FilePath -> Action ()
tarBz2A = FilePath
-> (ByteString -> ByteString)
-> [FilePath]
-> FilePath
-> Action ()
tarGenericA FilePath
"tar-bz2" ByteString -> ByteString
Bz2.compress

-- | @since 1.0.1.0
tarXzA :: [FilePath] -- ^ Files to pack up
       -> FilePath -- ^ File name of resultant tarball
       -> Action ()
tarXzA :: [FilePath] -> FilePath -> Action ()
tarXzA = FilePath
-> (ByteString -> ByteString)
-> [FilePath]
-> FilePath
-> Action ()
tarGenericA FilePath
"lzma" ByteString -> ByteString
Lzma.compress