-------------------------------------------------------------------------------- --- Some utilities for deailing with files and directories --- for the Curry Package Manager. -------------------------------------------------------------------------------- module CPM.FileUtil ( joinSearchPath , copyDirectory , createSymlink , removeSymlink , isSymlink, linkTarget, getRealPath , copyDirectoryFollowingSymlinks , quote , tempDir , cleanTempDir , inTempDir , inDirectory , recreateDirectory , removeDirectoryComplete , safeReadFile, checkAndGetVisibleDirectoryContents , whenFileExists, ifFileExists, writeFileIfNotExists ) where import System.Directory ( doesFileExist, doesDirectoryExist , setCurrentDirectory, getDirectoryContents , getTemporaryDirectory, doesDirectoryExist , createDirectory, createDirectoryIfMissing , getAbsolutePath, getCurrentDirectory ) import System.Process ( system, exitWith, getPID ) import System.Environment ( getEnv ) import System.FilePath ( FilePath, replaceFileName, () , searchPathSeparator ) import Data.List ( intercalate, isPrefixOf, splitOn ) import Control.Monad ( when ) import System.IOExts ( evalCmd, readCompleteFile ) import CPM.Helpers ( stripSpaces ) --- Joins a list of directories into a search path. joinSearchPath :: [FilePath] -> String joinSearchPath = intercalate [searchPathSeparator] . map emptyPath2Dot where emptyPath2Dot p = if null p then "." else p --- Recursively copies a directory structure. copyDirectory :: String -> String -> IO () copyDirectory src dst = do retCode <- system $ "cp -pR \"" ++ src ++ "\" \"" ++ dst ++ "\"" if retCode /= 0 then error $ "Copy failed with " ++ (show retCode) else return () --- Recursively copies a directory structure following symlinks, i.e. links --- get replaced by copies in the destination. copyDirectoryFollowingSymlinks :: String -> String -> IO () copyDirectoryFollowingSymlinks src dst = do retCode <- system $ "cp -pLR \"" ++ src ++ "\" \"" ++ dst ++ "\"" if retCode /= 0 then error $ "Copy failed with " ++ (show retCode) else return () --- Creates a new symlink. createSymlink :: String -> String -> IO Int createSymlink from to = system $ "ln -s " ++ (quote from) ++ " " ++ (quote to) --- Deletes a symlink. removeSymlink :: String -> IO Int removeSymlink link = system $ "rm " ++ quote link --- Tests whether a file is a symlink. isSymlink :: String -> IO Bool isSymlink link = do (code, _, _) <- evalCmd "readlink" ["-n", link] "" return $ code == 0 --- Gets the target of a symlink. linkTarget :: String -> IO String linkTarget link = do (rc, out, _) <- evalCmd "readlink" ["-n", link] "" return $ if rc == 0 then replaceFileName link out else "" --- Returns the absolute real path for a given file path --- by following all symlinks in all path components. getRealPath :: String -> IO String getRealPath path = do (rc, out, _) <- evalCmd "realpath" [path] "" if rc == 0 then return (stripSpaces out) else getAbsolutePath path --- Puts a file argument into quotes to avoid problems with files containing --- blanks. quote :: String -> String quote s = "\"" ++ s ++ "\"" --- Gets a temporary directory for some CPM command. tempDir :: IO String tempDir = do t <- getTemporaryDirectory pid <- getPID return (t "cpm" ++ show pid) --- Removes the temporary directory for some CPM command. cleanTempDir :: IO () cleanTempDir = tempDir >>= removeDirectoryComplete --- Executes an IO action with the current directory set to CPM's temporary --- directory. inTempDir :: IO b -> IO b inTempDir b = do t <- tempDir exists <- doesDirectoryExist t if exists then return () else createDirectory t inDirectory t b --- Executes an IO action with the current directory set to a specific --- directory. inDirectory :: String -> IO b -> IO b inDirectory dir b = do previous <- getCurrentDirectory setCurrentDirectory dir b' <- b setCurrentDirectory previous return b' --- Recreates a directory. Deletes its contents if it already exists. recreateDirectory :: String -> IO () recreateDirectory dir = do removeDirectoryComplete dir createDirectoryIfMissing True dir --- Deletes a directory and its contents, if it exists, otherwise nothing --- is done. removeDirectoryComplete :: String -> IO () removeDirectoryComplete dir = do exists <- doesDirectoryExist dir when exists $ system ("rm -Rf " ++ quote dir) >> return () --- Reads the complete contents of a file and catches any error --- (which is returned). safeReadFile :: String -> IO (Either IOError String) safeReadFile fname = do catch (readCompleteFile fname >>= return . Right) (return . Left) --- Returns the list of all entries in a directory and terminates with --- an error message if the directory does not exist. checkAndGetDirectoryContents :: FilePath -> IO [FilePath] checkAndGetDirectoryContents dir = do exdir <- doesDirectoryExist dir if exdir then getDirectoryContents dir else do putStrLn $ "ERROR: Directory '" ++ dir ++ "' does not exist!" exitWith 1 --- Returns the list of all visible entries in a directory (i.e., not starting --- with '.') and terminates with an error message if the directory --- does not exist. checkAndGetVisibleDirectoryContents :: FilePath -> IO [FilePath] checkAndGetVisibleDirectoryContents dir = checkAndGetDirectoryContents dir >>= return . filter (not . isPrefixOf ".") --- Performs one of two actions depending on the existence of a file. ifFileExists :: FilePath -> IO a -> IO a -> IO a ifFileExists fname thenact elseact = do exfile <- doesFileExist fname if exfile then thenact else elseact --- Performs an action when a file exists. whenFileExists :: FilePath -> IO () -> IO () whenFileExists fname act = ifFileExists fname act (return ()) --- Writes a file with a given contents if it does not exist. writeFileIfNotExists :: FilePath -> String -> IO () writeFileIfNotExists fname cnt = ifFileExists fname (return ()) (writeFile fname cnt)