Lastik-0.6.2: System/Build/Directory.hs
-- | A module for performing operations on directories.
module System.Build.Directory(
-- * Directory manipulating
chdir,
mkdir,
rmdir,
-- * Directory archiving
archiveDirectories,
writeArchive,
writeHashArchive,
-- * Copying directories
copy,
copyl,
dropRoot,
dropRoot'
) where
import System.Directory
import System.FilePath
import System.Build.FilePather
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)
-- | 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)
-- | Copy the contents of a directory to another, perhaps trimming parent directories.
copy :: RecursePredicate -- ^ The recursion predicate to search for files in the source directory.
-> FilterPredicate -- ^ The filter predicate to search for files in the source directory.
-> FilePath -- ^ The source directory.
-> FilePath -- ^ The target directory.
-> IO ()
copy r f from to = do isf <- doesFileExist from
if isf
then error ("Cannot copy from file " ++ from)
else do isd <- doesDirectoryExist from
if isd
then do dis <- doesFileExist to
if dis
then error ("Cannot copy to" ++ to ++ " (a file)")
else do j <- find r f from
k <- filterM doesFileExist j
mkdir to
mapM_ (\z -> let t = to </> dropWhile (pathSeparator ==) (drop (length from) z)
in do mkdir (dropFileName t)
copyFile z t) k
else error (from ++ " is not a directory")
-- | Copy the contents of a directory to another, perhaps trimming parent directories.
copyl :: 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 ()
copyl 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))
-- | 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, d) -> writeFile (f <.> d) (k s))
-- | 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)