1{-# LANGUAGE CPP #-} 2module Darcs.Util.File 3 ( 4 -- * Files and directories 5 getFileStatus 6 , withCurrentDirectory 7 , doesDirectoryReallyExist 8 , removeFileMayNotExist 9 , getRecursiveContents 10 , getRecursiveContentsFullPath 11 -- * OS-dependent special directories 12 , xdgCacheDir 13 , osxCacheDir 14 ) where 15 16import Darcs.Prelude 17 18import Control.Exception ( bracket ) 19import Control.Monad ( when, unless, forM ) 20 21import Data.List ( lookup ) 22 23import System.Environment ( getEnvironment ) 24import System.Directory ( removeFile, getHomeDirectory, 25 getAppUserDataDirectory, doesDirectoryExist, 26 createDirectory, listDirectory ) 27import System.IO.Error ( catchIOError ) 28import System.Posix.Files( getSymbolicLinkStatus, FileStatus, isDirectory ) 29#ifndef WIN32 30import System.Posix.Files( setFileMode, ownerModes ) 31#endif 32import System.FilePath.Posix ( (</>) ) 33 34import Darcs.Util.Exception ( catchall, catchNonExistence ) 35import Darcs.Util.Path( FilePathLike, getCurrentDirectory, setCurrentDirectory, toFilePath ) 36 37withCurrentDirectory :: FilePathLike p 38 => p 39 -> IO a 40 -> IO a 41withCurrentDirectory name m = 42 bracket 43 (do cwd <- getCurrentDirectory 44 when (toFilePath name /= "") (setCurrentDirectory name) 45 return cwd) 46 (\oldwd -> setCurrentDirectory oldwd `catchall` return ()) 47 (const m) 48 49getFileStatus :: FilePath -> IO (Maybe FileStatus) 50getFileStatus f = 51 Just `fmap` getSymbolicLinkStatus f `catchIOError` (\_-> return Nothing) 52 53doesDirectoryReallyExist :: FilePath -> IO Bool 54doesDirectoryReallyExist f = 55 catchNonExistence (isDirectory `fmap` getSymbolicLinkStatus f) False 56 57removeFileMayNotExist :: FilePathLike p => p -> IO () 58removeFileMayNotExist f = catchNonExistence (removeFile $ toFilePath f) () 59 60-- |osxCacheDir assumes @~/Library/Caches/@ exists. 61osxCacheDir :: IO (Maybe FilePath) 62osxCacheDir = do 63 home <- getHomeDirectory 64 return $ Just $ home </> "Library" </> "Caches" 65 `catchall` return Nothing 66 67-- |xdgCacheDir returns the $XDG_CACHE_HOME environment variable, 68-- or @~/.cache@ if undefined. See the FreeDesktop specification: 69-- http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html 70xdgCacheDir :: IO (Maybe FilePath) 71xdgCacheDir = do 72 env <- getEnvironment 73 d <- case lookup "XDG_CACHE_HOME" env of 74 Just d -> return d 75 Nothing -> getAppUserDataDirectory "cache" 76 exists <- doesDirectoryExist d 77 78 -- If directory does not exist, create it with permissions 0700 79 -- as specified by the FreeDesktop standard. 80 unless exists $ do createDirectory d 81#ifndef WIN32 82 -- see http://bugs.darcs.net/issue2334 83 setFileMode d ownerModes 84#endif 85 return $ Just d 86 `catchall` return Nothing 87 88-- |getRecursiveContents returns all files under topdir that aren't 89-- directories. 90getRecursiveContents :: FilePath -> IO [FilePath] 91getRecursiveContents topdir = do 92 entries <- listDirectory topdir 93 paths <- forM entries $ \name -> do 94 let path = topdir </> name 95 isDir <- doesDirectoryExist path 96 if isDir 97 then getRecursiveContents path 98 else return [name] 99 return (concat paths) 100 101-- |getRecursiveContentsFullPath returns all files under topdir 102-- that aren't directories. 103-- Unlike getRecursiveContents this function returns the full path. 104getRecursiveContentsFullPath :: FilePath -> IO [FilePath] 105getRecursiveContentsFullPath topdir = do 106 entries <- listDirectory topdir 107 paths <- forM entries $ \name -> do 108 let path = topdir </> name 109 isDir <- doesDirectoryExist path 110 if isDir 111 then getRecursiveContentsFullPath path 112 else return [path] 113 return (concat paths) 114