-- | A module for performing operations on directories. module Lastik.Directory( chdir, archiveDirectories, writeArchive, writeHashArchive, copyDir, dropRoot, dropRoot', mkdir, rmdir ) where import System.Directory import System.FilePath import Lastik.Find import Codec.Archive.Zip import qualified Data.ByteString.Lazy as B import Control.Monad import Control.Exception import Data.Digest.Pure.MD5 import Data.Digest.Pure.SHA -- | Change to the given directory, then execute the given action, then change back to the original directory. chdir :: FilePath -- ^ The directory to change to. -> IO a -- ^ The action to execute in the given directory. -> IO a -- ^ The result of executing the given action. chdir d a = bracket getCurrentDirectory setCurrentDirectory (\_ -> setCurrentDirectory d >> a) -- | Create a zip archive by changing into directories and archiving the contents. archiveDirectories :: [(FilePath, FilePath)] -- ^ A list of base directories to change to and contents of that directory to archive. -> RecursePredicate -- ^ The recursion predicate to search for files to archive. -> FilterPredicate -- ^ The filter predicate to search for files to archive. -> [ZipOption] -- ^ The options during the creation of the archive. -> IO Archive -- ^ The constructed archive. archiveDirectories dirs rp fp opts = foldM (\a (d, f) -> chdir d $ do j <- find rp fp f addFilesToArchive opts a j) emptyArchive dirs -- | Writes a zip archive to a file. writeArchive :: [(FilePath, FilePath)] -- ^ A list of base directories to change to and contents of that directory to archive. -> RecursePredicate -- ^ The recursion predicate to search for files to archive. -> FilterPredicate -- ^ The filter predicate to search for files to archive. -> [ZipOption] -- ^ The options during the creation of the archive. -> FilePath -- ^ The file to write the archive to. -> IO () writeArchive dirs rp fp opts f = do a <- archiveDirectories dirs rp fp opts B.writeFile f (fromArchive a) -- | Writes a zip archive to a file then computes a MD5 and SHA1 hash and writes them to files with @".md5"@ and @".sha1"@ extensions. writeHashArchive :: [(FilePath, FilePath)] -- ^ A list of base directories to change to and contents of that directory to archive. -> RecursePredicate -- ^ The recursion predicate to search for files to archive. -> FilterPredicate -- ^ The filter predicate to search for files to archive. -> [ZipOption] -- ^ The options during the creation of the archive. -> FilePath -- ^ The file to write the archive to and the prefix name of the files containing the hashes. -> IO () writeHashArchive dirs rp fp opts f = do a <- archiveDirectories dirs rp fp opts let s = fromArchive a B.writeFile f s forM_ [(show . md5, "md5"), (show . sha1, "sha1")] (\(k, a) -> writeFile (f <.> a) (k s)) -- | Copy the contents of a directory to another, perhaps trimming parent directories. copyDir :: RecursePredicate -- ^ The recursion predicate to search for files in the source directory. -> FilterPredicate -- ^ The filter predicate to search for files in the source directory. -> Int -- ^ The number of parent directories to drop before copying to the target directory. -> FilePath -- ^ The source directory. -> FilePath -- ^ The target directory. -> IO () copyDir rp fp levels from to = do s <- find rp fp from forM_ s (\f -> let d = dropRoot' levels f in do mkdir (to dropFileName d) copyFile f (to d)) -- | Drops the parent directory of a given file path. -- -- > dropRoot "/foo/bar" == "/bar" -- > dropRoot "foo/bar" == "bar" -- > dropRoot "foo" == "" -- > dropRoot "" == "" dropRoot :: FilePath -- ^ The file path to drop the parent directory from. -> String -- ^ The file path without a parent directory. dropRoot [] = [] dropRoot (x:xs) = (if x == pathSeparator then id else drop 1) (dropWhile (/= pathSeparator) xs) -- | Drops the parent directory ('dropRoot') of a given file path multiple times. -- -- > dropRoot' 0 "/foo/bar" == "/foo/bar" -- > dropRoot' 1 "/foo/bar" == "/bar" -- > dropRoot' 1 "foo/bar" == "bar" -- > dropRoot' 2 "foo/bar" == "" -- > dropRoot' 10 "foo/bar" == "" dropRoot' :: Int -- ^ The number of times to drop the parent directory. -> FilePath -- ^ The file path to drop parent directories from. -> FilePath -- ^ Te file path without parent directories. dropRoot' n k = (iterate dropRoot k) !! (if n < 0 then 0 else n) -- | Creates the given directory and its parents if it doesn't exist. mkdir :: FilePath -- ^ The directory to create. -> IO () mkdir = createDirectoryIfMissing True -- | Removes the given directory recursively if it exists. rmdir :: FilePath -- ^ The directory to remove. -> IO () rmdir d = doesDirectoryExist d >>= flip when (removeDirectoryRecursive d)