ztar 0.0.2 → 0.0.3
raw patch · 10 files changed
+448/−64 lines, 10 filesdep +QuickCheckdep +directorydep +extradep ~base
Dependencies added: QuickCheck, directory, extra, filepath, tasty, tasty-quickcheck, zip
Dependency ranges changed: base
Files
- CHANGELOG.md +10/−0
- README.md +25/−2
- src/Codec/Archive/Tar/GZip.hs +0/−51
- src/Codec/Archive/ZTar.hs +61/−0
- src/Codec/Archive/ZTar/GZip.hs +47/−0
- src/Codec/Archive/ZTar/Tar.hs +56/−0
- src/Codec/Archive/ZTar/Zip.hs +75/−0
- test/Example.hs +12/−4
- test/Test.hs +106/−0
- ztar.cabal +56/−7
CHANGELOG.md view
@@ -1,3 +1,13 @@+# ztar 0.0.3++Breaking changes:+* `create` now takes compression algorithm++Other changes:+* `extract` automatically detects compression algorithm used+* `extract` now handles ZIP archives and uncompressed TAR archives+* Add integration testing+ # ztar 0.0.2 * Add createGZ'
README.md view
@@ -1,5 +1,28 @@ # ztar -Reading and writing compressed `.tar` archives.+Reading and writing arbitrary archives. -An extension of the `tar` library that can create/extract compressed tar archives.+An extension of the `tar` library that, similar to the `tar` UNIX executable,+can create an archive with a given compression algorithm and automatically+detect the compression algorithm of an archive when extracting.++```+import Codec.Archive.ZTar++-- equivalent to `Codec.Archive.Tar.create "archive.tar" "dist/" ["."]`+create' NoCompression "archive.tar" "dist/" ["."]++-- helper to compress a single directory; equivalent to previous line+create NoCompression "archive.tar" "dist/"++-- compress with GZip+create GZip "archive.tar.gz" "dist/"++-- compress with Zip+create Zip "archive.zip" "dist/"++-- automatically determines compression+extract "archive-tar/" "archive.tar"+extract "archive-gz/" "archive.tar.gz"+extract "archive-zip/" "archive.zip"+```
− src/Codec/Archive/Tar/GZip.hs
@@ -1,51 +0,0 @@-{-|-Module : Codec.Archive.Tar.GZip-Maintainer : Brandon Chinn <brandonchinn178@gmail.com>-Stability : experimental-Portability : portable--Functions to create/extract compressed tar archives.--}--module Codec.Archive.Tar.GZip (createGZ, createGZ', extractGZ) where--import qualified Codec.Archive.Tar as Tar-import qualified Codec.Compression.GZip as GZ-import qualified Data.ByteString.Lazy as BS---- | Create a new @.tar@ file from the given directory.------ It is equivalent to calling the standard 'tar' program like so:------ @$ tar -czf tarball.tar -C dir .@------ See 'Tar.create' for more details.-createGZ :: FilePath -- ^ tar archive- -> FilePath -- ^ directory to archive- -> IO ()-createGZ tar dir = createGZ' tar dir ["."]---- | Create a new @.tar@ file from the given paths.------ It is equivalent to calling the standard 'tar' program like so:------ @$ tar -czf tarball.tar -C base paths@------ See 'Tar.create' for more details.-createGZ' :: FilePath -- ^ tar archive- -> FilePath -- ^ base directory- -> [FilePath] -- ^ files and paths to compress, relative to base directory- -> IO ()-createGZ' tar base paths = BS.writeFile tar . GZ.compress . Tar.write =<< Tar.pack base paths---- | Extract all the files contained in a @.tar@ file.------ It is equivalent to calling the standard 'tar' program like so:------ @$ tar -xzf tarball.tar -C dir@------ See 'Tar.extract' for more details.-extractGZ :: FilePath -- ^ destination directory- -> FilePath -- ^ tar archive- -> IO ()-extractGZ dir tar = Tar.unpack dir . Tar.read . GZ.decompress =<< BS.readFile tar
+ src/Codec/Archive/ZTar.hs view
@@ -0,0 +1,61 @@+{-|+Module : Codec.Archive.ZTar+Maintainer : Brandon Chinn <brandonchinn178@gmail.com>+Stability : experimental+Portability : portable++Functions to create/extract archives.+-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}++module Codec.Archive.ZTar+ ( Compression(..)+ , create+ , create'+ , extract+ ) where++import qualified Data.ByteString.Lazy as BS++import qualified Codec.Archive.ZTar.GZip as GZip+import qualified Codec.Archive.ZTar.Tar as Tar+import qualified Codec.Archive.ZTar.Zip as Zip++-- | The compression algorithm to use when creating an archive.+data Compression+ = NoCompression+ | GZip+ | Zip+ deriving (Show)++-- | Create a new archive from the given directory using the given compression algorithm.+create :: Compression+ -> FilePath -- ^ archive file to create+ -> FilePath -- ^ directory to archive+ -> IO ()+create compression archive dir = create' compression archive dir ["."]++-- | Create a new archive from the given paths using the given compression algorithm.+create' :: Compression+ -> FilePath -- ^ archive file to create+ -> FilePath -- ^ base directory+ -> [FilePath] -- ^ files and paths to compress, relative to base directory+ -> IO ()+create' compression = case compression of+ NoCompression -> Tar.create+ GZip -> GZip.create+ Zip -> Zip.create++-- | Extract an archive to the given directory. Automatically detects the compression algorithm.+-- used in the archive.+extract :: FilePath -- ^ destination directory+ -> FilePath -- ^ archive to extract+ -> IO ()+extract dir archive = BS.readFile archive >>= \case+ Tar.TarFormat -> Tar.extract dir archive+ GZip.GZipFormat -> GZip.extract dir archive+ Zip.ZipFormat -> Zip.extract dir archive+ _ -> fail $ "Could not recognize archive format: " ++ archive
+ src/Codec/Archive/ZTar/GZip.hs view
@@ -0,0 +1,47 @@+{-|+Module : Codec.Archive.ZTar.GZip+Maintainer : Brandon Chinn <brandonchinn178@gmail.com>+Stability : experimental+Portability : portable++Functions to create/extract GZIP-compressed archives.+-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}++module Codec.Archive.ZTar.GZip+ ( pattern GZipFormat+ , create+ , extract+ ) where++import qualified Codec.Archive.Tar as Tar+import qualified Codec.Compression.GZip as GZ+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BS++-- | A pattern matching any ByteString in the GZip format.+pattern GZipFormat :: ByteString+pattern GZipFormat <- ((BS.pack [0x1F, 0x8B] `BS.isPrefixOf`) -> True)++-- | Create a new archive compressed with GZip from the given paths.+--+-- It is equivalent to calling the standard 'tar' program like so:+--+-- @$ tar -czf archive -C base paths@+create :: FilePath -- ^ archive to create+ -> FilePath -- ^ base directory+ -> [FilePath] -- ^ files and paths to compress, relative to base directory+ -> IO ()+create archive base paths = BS.writeFile archive . GZ.compress . Tar.write =<< Tar.pack base paths++-- | Extract all the files contained in an archive compressed with GZip.+--+-- It is equivalent to calling the standard 'tar' program like so:+--+-- @$ tar -xf archive -C dir@+extract :: FilePath -- ^ destination directory+ -> FilePath -- ^ archive to extract+ -> IO ()+extract dir archive = Tar.unpack dir . Tar.read . GZ.decompress =<< BS.readFile archive
+ src/Codec/Archive/ZTar/Tar.hs view
@@ -0,0 +1,56 @@+{-|+Module : Codec.Archive.ZTar.Tar+Maintainer : Brandon Chinn <brandonchinn178@gmail.com>+Stability : experimental+Portability : portable++Functions to create/extract uncompressed tar archives.+-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}++module Codec.Archive.ZTar.Tar+ ( pattern TarFormat+ , create+ , extract+ ) where++import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BS++import qualified Codec.Archive.Tar as Tar++-- | A pattern matching any ByteString in an uncompressed TAR format.+pattern TarFormat :: ByteString+pattern TarFormat <- (matchesTar -> True)++matchesTar :: ByteString -> Bool+matchesTar (BS.drop 0x101 -> s) = any (`BS.isPrefixOf` s) tarMagicNumbers+ where+ tarMagicNumbers = map BS.pack+ [ [0x75, 0x73, 0x74, 0x61, 0x72, 0x00, 0x30, 0x30]+ , [0x75, 0x73, 0x74, 0x61, 0x72, 0x20, 0x20, 0x00]+ ]++-- | Create a new uncompressed tar archive from the given paths.+--+-- It is equivalent to calling the standard 'tar' program like so:+--+-- @$ tar -cf archive -C base paths@+create :: FilePath -- ^ archive to create+ -> FilePath -- ^ base directory+ -> [FilePath] -- ^ files and paths to compress, relative to base directory+ -> IO ()+create = Tar.create++-- | Extract all the files contained in an uncompressed tar archive.+--+-- It is equivalent to calling the standard 'tar' program like so:+--+-- @$ tar -xf archive -C dir@+extract :: FilePath -- ^ destination directory+ -> FilePath -- ^ archive to extract+ -> IO ()+extract = Tar.extract
+ src/Codec/Archive/ZTar/Zip.hs view
@@ -0,0 +1,75 @@+{-|+Module : Codec.Archive.ZTar.Zip+Maintainer : Brandon Chinn <brandonchinn178@gmail.com>+Stability : experimental+Portability : portable++Functions to create/extract ZIP-compressed archives.+-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}++module Codec.Archive.ZTar.Zip+ ( pattern ZipFormat+ , create+ , extract+ ) where++import qualified Codec.Archive.Zip as Zip+import Control.Monad.IO.Class (liftIO)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy as BS+import System.Directory+ ( createDirectoryIfMissing+ , doesFileExist+ , doesDirectoryExist+ , listDirectory+ , renameFile+ , withCurrentDirectory+ )+import System.FilePath ((</>))++-- | A pattern matching any ByteString in the Zip format.+pattern ZipFormat :: ByteString+pattern ZipFormat <- ((BS.pack [0x50, 0x4B, 0x03, 0x04] `BS.isPrefixOf`) -> True)++-- | Create a new archive compressed with Zip from the given paths.+--+-- It is equivalent to calling the standard 'zip' program like so:+--+-- @$ CURR=$PWD; (cd base && zip -r archive paths && mv archive $CURR)@+create :: FilePath -- ^ archive to create+ -> FilePath -- ^ base directory+ -> [FilePath] -- ^ files and paths to compress, relative to base directory+ -> IO ()+create archive base paths = do+ withCurrentDirectory base $ Zip.createArchive archive $ mapM_ insert paths+ renameFile (base </> archive) archive+ where+ insert path = do+ isFile <- liftIO $ doesFileExist path+ isDir <- liftIO $ doesDirectoryExist path+ if+ | isFile -> insertFile path+ | isDir -> insertDir path+ | otherwise -> fail $ "Path does not exist: " ++ path+ insertFile path = do+ path' <- Zip.mkEntrySelector path+ Zip.loadEntry Zip.BZip2 path' path+ insertDir path =+ let mkPath = if path == "." then id else (path </>)+ in mapM_ (insert . mkPath) =<< liftIO (listDirectory path)++-- | Extract all the files contained in an archive compressed with Zip.+--+-- It is equivalent to calling the standard 'zip' program like so:+--+-- @$ mkdir -p dir && unzip archive -d dir@+extract :: FilePath -- ^ destination directory+ -> FilePath -- ^ archive to extract+ -> IO ()+extract dir archive = do+ createDirectoryIfMissing True dir+ Zip.withArchive archive $ Zip.unpackInto dir
test/Example.hs view
@@ -1,16 +1,24 @@ {-# LANGUAGE QuasiQuotes #-} -import Codec.Archive.Tar.GZip (createGZ, extractGZ)+import Codec.Archive.ZTar import Control.Monad (unless) import Path import Path.IO (ensureDir, removeDirRecur, removeFile, withSystemTempDir) main :: IO ()-main = withSystemTempDir "" $ \dir -> do+main = mapM_ runTest+ [ NoCompression+ , GZip+ , Zip+ ]++runTest :: Compression -> IO ()+runTest compression = withSystemTempDir "" $ \dir -> do+ putStrLn $ "\nTesting: " ++ show compression mapM_ (mkFile dir) files- createGZ (fromRelFile archive) $ fromAbsDir dir+ create compression (fromRelFile archive) $ fromAbsDir dir - extractGZ (fromRelDir extractDir) $ fromRelFile archive+ extract (fromRelDir extractDir) $ fromRelFile archive contents <- mapM (readFile . fromRelFile . (extractDir </>)) files putStrLn $ unlines contents unless (contents == map show files) $
+ test/Test.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE QuasiQuotes #-}++import Codec.Archive.ZTar+import Control.Monad (forM, forM_)+import Control.Monad.Extra (unlessM)+import Data.List (dropWhileEnd, intercalate, nub)+import Data.Maybe (fromJust)+import Path+ ( Dir+ , File+ , Rel+ , Path+ , absdir+ , fromAbsDir+ , fromAbsFile+ , parent+ , parseRelDir+ , parseRelFile+ , (</>)+ )+import Path.IO (doesFileExist, ensureDir, isLocationOccupied, withTempDir)+import Test.QuickCheck (Arbitrary(..), Gen, Property, elements, listOf, listOf1, suchThat)+import Test.QuickCheck.Monadic (monadicIO, pick, run)+import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.QuickCheck (testProperty)++main :: IO ()+main = defaultMain $ testGroup "ztar"+ [ testProperty "Create/extract uncompressed tar archives" $ testZTar NoCompression+ , testProperty "Create/extract GZip tar archives" $ testZTar GZip+ , testProperty "Create/extract Zip archives" $ testZTar Zip+ ]++testZTar :: Compression -> Property+testZTar compression = monadicIO $ do+ archive:src:dest:paths <- pick $ uniqueListOf 4 arbitrary++ run $ withTempDir [absdir|/tmp|] "" $ \dir -> do+ let paths' = map toRelFile paths+ archive' = dir </> toRelFile archive+ src' = dir </> toRelDir src+ dest' = dir </> toRelDir dest++ -- write files to be bundled+ forM_ paths' $ \path -> do+ let path' = src' </> path+ -- case writing `a` when `a/b` already exists+ unlessM (isLocationOccupied path') $ do+ ensureDir $ parent path'+ writeFile (fromAbsFile path') (show path)++ -- create and extract archive+ ensureDir $ parent archive'+ create compression (fromAbsFile archive') (fromAbsDir src')+ extract (fromAbsDir dest') (fromAbsFile archive')++ -- check files+ fmap and $ forM paths' $ \path -> do+ let path' = dest' </> path+ isExist <- isLocationOccupied path'+ isFile <- doesFileExist path'+ case (isExist, isFile) of+ (False, _) -> return False+ (True, True) -> do+ contents <- readFile $ fromAbsFile path'+ return $ contents == show path+ (True, False) -> return True++{- Helpers -}++-- | Generate a unique list with length at least N.+uniqueListOf :: Eq a => Int -> Gen a -> Gen [a]+uniqueListOf 0 gen = nub <$> listOf gen+uniqueListOf n gen = do+ rest <- uniqueListOf (n - 1) gen+ x <- gen `suchThat` (`notElem` rest)+ return $ x : rest++-- | A valid relative file path.+newtype ValidPath = ValidPath { unPath :: FilePath }+ deriving (Show,Eq)++instance Arbitrary ValidPath where+ arbitrary = ValidPath . truncatePath . intercalate "/" . map unName <$> listOf1 arbitrary+ where+ truncatePath = dropWhileEnd (`elem` ['/', '.']) . take 50++toRelFile :: ValidPath -> Path Rel File+toRelFile = fromJust . parseRelFile . unPath++toRelDir :: ValidPath -> Path Rel Dir+toRelDir = fromJust . parseRelDir . unPath++-- | A valid file or directory name.+newtype ValidName = ValidName { unName :: String }+ deriving (Show)++instance Arbitrary ValidName where+ arbitrary = do+ -- https://stackoverflow.com/a/2306003/8565175+ name <- take 14 <$> listOf1 (elements validChars)+ if last name == '.' || name `elem` ["nul"]+ then arbitrary+ else return $ ValidName name+ where+ validChars = ['a'..'z'] ++ ['0'..'9'] ++ ['.', '_', '-']
ztar.cabal view
@@ -1,12 +1,12 @@ name: ztar-version: 0.0.2+version: 0.0.3 license: BSD3 license-file: LICENSE.md author: Brandon Chinn <brandonchinn178@gmail.com> maintainer: Brandon Chinn <brandonchinn178@gmail.com> category: Codec-synopsis: Creating and extracting compressed tar archives-description: Creating and extracting compressed tar archives.+synopsis: Creating and extracting arbitrary archives+description: Creating and extracting arbitrary archives. build-type: Simple cabal-version: 1.18 extra-doc-files: CHANGELOG.md, README.md@@ -15,17 +15,34 @@ type: git location: https://github.com/brandonchinn178/ztar.git +flag dev+ description: Turn on development settings.+ manual: True+ default: False+ library hs-source-dirs: src default-language: Haskell2010- exposed-modules: Codec.Archive.Tar.GZip+ exposed-modules: Codec.Archive.ZTar+ Codec.Archive.ZTar.GZip+ Codec.Archive.ZTar.Tar+ Codec.Archive.ZTar.Zip build-depends: base >= 4.7 && < 5 , bytestring >= 0.10.8 && < 0.11+ , directory >= 1.3 && < 1.4+ , filepath >= 1.4.1 && < 1.5 , tar >= 0.5 && < 0.6+ , zip >= 1.0 && < 1.2 , zlib >= 0.6 && < 0.7- ghc-options:- -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wcompat- -Wredundant-constraints -Wnoncanonical-monad-instances+ ghc-options: -Wall+ if flag(dev)+ ghc-options: -Werror+ if flag(dev) && impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wnoncanonical-monad-instances+ -Wnoncanonical-monadfail-instances test-suite example type: exitcode-stdio-1.0@@ -36,3 +53,35 @@ , path , path-io , ztar+ ghc-options: -Wall+ if flag(dev)+ ghc-options: -Werror+ if flag(dev) && impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wnoncanonical-monad-instances+ -Wnoncanonical-monadfail-instances++test-suite ztar-test+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Test.hs+ build-depends: base+ , extra+ , path+ , path-io+ , QuickCheck+ , tasty+ , tasty-quickcheck+ , ztar+ ghc-options: -Wall+ if flag(dev)+ ghc-options: -Werror+ if flag(dev) && impl(ghc >= 8.0)+ ghc-options: -Wcompat+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wnoncanonical-monad-instances+ -Wnoncanonical-monadfail-instances