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