module Archive.Compression ( Decompressor
                           , Compressor
                           , unpackFileToDirAndDecompress
                           , packFromFilesAndCompress
                           , packFromDirAndCompress
                           , packSrcDirAndCompress
                           , unpackToDir
                           , packFiles
                           ) where

import           Archive
import qualified Data.ByteString.Lazy       as BSL
import           Data.List                  (isSuffixOf)
import           System.Directory.Recursive

type Decompressor = BSL.ByteString -> BSL.ByteString
type Compressor = BSL.ByteString -> BSL.ByteString

-- | @since 1.0.1.0
packFiles :: [FilePath] -- ^ Files and directories to write to archive
          -> IO BSL.ByteString -- ^ 'BSL.ByteString' containing archive
packFiles :: [FilePath] -> IO ByteString
packFiles = [FP] -> IO ByteString
packFilesRaw ([FP] -> IO ByteString)
-> ([FilePath] -> [FP]) -> [FilePath] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FP) -> [FilePath] -> [FP]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FP
toFP

-- | @since 1.0.1.0
unpackToDir :: FilePath -> BSL.ByteString -> IO ()
unpackToDir :: FilePath -> ByteString -> IO ()
unpackToDir = FP -> ByteString -> IO ()
unpackToDirRaw (FP -> ByteString -> IO ())
-> (FilePath -> FP) -> FilePath -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FP
toFP

-- | @since 0.2.0.0
unpackFileToDirAndDecompress :: Decompressor -- ^ Decompression to use
                             -> FilePath -- ^ Filepath pointing to archive
                             -> FilePath -- ^ Directory
                             -> IO ()
unpackFileToDirAndDecompress :: Decompressor -> FilePath -> FilePath -> IO ()
unpackFileToDirAndDecompress Decompressor
f FilePath
tar FilePath
dir = FilePath -> ByteString -> IO ()
unpackToDir FilePath
dir (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Decompressor
f Decompressor -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BSL.readFile FilePath
tar)

-- | @since 0.2.0.0
packFromDirAndCompress :: Compressor
                       -> FilePath -- ^ Directory to pack up
                       -> FilePath -- ^ Destination tarball
                       -> IO ()
packFromDirAndCompress :: Decompressor -> FilePath -> FilePath -> IO ()
packFromDirAndCompress Decompressor
f FilePath
dir FilePath
tar = Decompressor -> FilePath -> [FilePath] -> IO ()
packFromFilesAndCompress Decompressor
f FilePath
tar ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
getDirRecursive FilePath
dir

-- | Pack up source files, ignoring version control directories and common
-- artifact directories
--
-- @since 0.2.1.0
packSrcDirAndCompress :: Compressor -> FilePath -> FilePath -> IO ()
packSrcDirAndCompress :: Decompressor -> FilePath -> FilePath -> IO ()
packSrcDirAndCompress Decompressor
f FilePath
dir FilePath
tar = Decompressor -> FilePath -> [FilePath] -> IO ()
packFromFilesAndCompress Decompressor
f FilePath
tar ([FilePath] -> IO ()) -> IO [FilePath] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (FilePath -> IO Bool) -> FilePath -> IO [FilePath]
getDirFiltered (Bool -> IO Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure(Bool -> IO Bool) -> (FilePath -> Bool) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.FilePath -> Bool
srcFilter) FilePath
dir

-- FIXME: isInfixOf?
srcFilter :: FilePath -> Bool
srcFilter :: FilePath -> Bool
srcFilter FilePath
fp | FilePath
".git" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"_darcs" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".hg" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".pijul" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"dist" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"dist-newstyle" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".stack-work" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"target" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".atspkg" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".shake" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".vagrant" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"tags" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"hspec-failures" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".github" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".travis.yml" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"TODO.md" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".yamllint" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".ctags" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".atsfmt.toml" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".gitignore" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".clang-format" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"stack.yaml.lock" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
"appveyor.yml" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | FilePath
".terraform" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fp = Bool
False
             | Bool
otherwise = Bool
True

-- | @since 0.2.0.0
packFromFilesAndCompress :: Compressor -> FilePath -> [FilePath] -> IO ()
packFromFilesAndCompress :: Decompressor -> FilePath -> [FilePath] -> IO ()
packFromFilesAndCompress Decompressor
f FilePath
tar [FilePath]
fps = FilePath -> ByteString -> IO ()
BSL.writeFile FilePath
tar (ByteString -> IO ()) -> IO ByteString -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Decompressor
f Decompressor -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> IO ByteString
packFiles [FilePath]
fps)