{-# 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 Path (parseAbsFile, parseAbsDir, parseRelFile)
import System.Directory
( createDirectoryIfMissing
, doesFileExist
, doesDirectoryExist
, listDirectory
, makeAbsolute
, withCurrentDirectory
)
import System.FilePath ((</>))
pattern ZipFormat :: ByteString
pattern ZipFormat <- ((BS.pack [0x50, 0x4B, 0x03, 0x04] `BS.isPrefixOf`) -> True)
create :: FilePath
-> FilePath
-> [FilePath]
-> IO ()
create archive base paths = do
archive' <- makeAbsolute archive >>= parseAbsFile
withCurrentDirectory base $ Zip.createArchive archive' $ mapM_ insert paths
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' <- parseRelFile path
path'' <- Zip.mkEntrySelector path'
Zip.loadEntry Zip.BZip2 (const $ return path'') path'
insertDir path =
let mkPath = if path == "." then id else (path </>)
in mapM_ (insert . mkPath) =<< liftIO (listDirectory path)
extract :: FilePath
-> FilePath
-> IO ()
extract dir archive = do
createDirectoryIfMissing True dir
archive' <- makeAbsolute archive >>= parseAbsFile
dir' <- makeAbsolute dir >>= parseAbsDir
Zip.withArchive archive' $ Zip.unpackInto dir'