Lastik 0.6.1 → 0.6.2
raw patch · 2 files changed
+132/−1 lines, 2 files
Files
- Lastik.cabal +2/−1
- System/Build/Directory.hs +130/−0
Lastik.cabal view
@@ -1,5 +1,5 @@ Name: Lastik-Version: 0.6.1+Version: 0.6.2 License: BSD3 License-File: LICENSE Author: Tony Morris <code@tmorris.net>@@ -23,6 +23,7 @@ GHC-Options: -Wall Exposed-Modules: System.Build,+ System.Build.Directory, System.Build.FilePather, System.Build.Args, System.Build.Runner,
+ System/Build/Directory.hs view
@@ -0,0 +1,130 @@+-- | 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)