mirror of http://darcs.net/screened (fork of darcs's darcs-reviewed)  (http://darcs.net/Development/GettingStarted)

root / src / Darcs / Util / File.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
{-# LANGUAGE CPP #-}
module Darcs.Util.File
    (
    -- * Files and directories
      getFileStatus
    , withCurrentDirectory
    , doesDirectoryReallyExist
    , removeFileMayNotExist
    -- * OS-dependent special directories
    , xdgCacheDir
    , osxCacheDir
    , getDirectoryContents
    , getRecursiveContents
    , getRecursiveContentsFullPath
    ) where

import Prelude ( lookup )
import Darcs.Prelude

import Control.Exception ( catch, bracket )
import Control.Monad ( when, unless, forM )

import System.Environment ( getEnvironment )
import System.Directory ( removeFile, getHomeDirectory,
                          getAppUserDataDirectory, doesDirectoryExist,
                          createDirectory, getDirectoryContents )
import System.IO.Error ( isDoesNotExistError, catchIOError )
import System.Posix.Files( getSymbolicLinkStatus, FileStatus, isDirectory )
#ifndef WIN32
import System.Posix.Files( setFileMode, ownerModes )
#endif
import System.FilePath.Posix ( (</>) )

import Darcs.Util.Exception ( catchall )
import Darcs.Util.Path( FilePathLike, getCurrentDirectory, setCurrentDirectory, toFilePath )

withCurrentDirectory :: FilePathLike p
                     => p
                     -> IO a
                     -> IO a
withCurrentDirectory name m =
    bracket
        (do cwd <- getCurrentDirectory
            when (toFilePath name /= "") (setCurrentDirectory name)
            return cwd)
        (\oldwd -> setCurrentDirectory oldwd `catchall` return ())
        (const m)

getFileStatus :: FilePath -> IO (Maybe FileStatus)
getFileStatus f =
  Just `fmap` getSymbolicLinkStatus f `catchIOError` (\_-> return Nothing)

doesDirectoryReallyExist :: FilePath -> IO Bool
doesDirectoryReallyExist f =
    catchNonExistence (isDirectory `fmap` getSymbolicLinkStatus f) False

removeFileMayNotExist :: FilePathLike p => p -> IO ()
removeFileMayNotExist f = catchNonExistence (removeFile $ toFilePath f) ()

catchNonExistence :: IO a -> a -> IO a
catchNonExistence job nonexistval =
    catch job $
    \e -> if isDoesNotExistError e then return nonexistval
                                   else ioError e

-- |osxCacheDir assumes @~/Library/Caches/@ exists.
osxCacheDir :: IO (Maybe FilePath)
osxCacheDir = do
    home <- getHomeDirectory
    return $ Just $ home </> "Library" </> "Caches"
    `catchall` return Nothing

-- |xdgCacheDir returns the $XDG_CACHE_HOME environment variable,
-- or @~/.cache@ if undefined. See the FreeDesktop specification:
-- http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html
xdgCacheDir :: IO (Maybe FilePath)
xdgCacheDir = do
    env <- getEnvironment
    d <- case lookup "XDG_CACHE_HOME" env of
           Just d  -> return d
           Nothing -> getAppUserDataDirectory "cache"
    exists <- doesDirectoryExist d

    -- If directory does not exist, create it with permissions 0700
    -- as specified by the FreeDesktop standard.
    unless exists $ do createDirectory d
#ifndef WIN32
    -- see http://bugs.darcs.net/issue2334
                       setFileMode d ownerModes
#endif
    return $ Just d
    `catchall` return Nothing

-- |getRecursiveContents returns all files under topdir that aren't
-- directories.
getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents topdir = do
  names <- getDirectoryContents topdir
  let properNames = filter (`notElem` [".", ".."]) names
  paths <- forM properNames $ \name -> do
    let path = topdir </> name
    isDir <- doesDirectoryExist path
    if isDir
      then getRecursiveContents path
      else return [name]
  return (concat paths)

-- |getRecursiveContentsFullPath returns all files under topdir
-- that aren't directories.
-- Unlike getRecursiveContents this function returns the full path.
getRecursiveContentsFullPath :: FilePath -> IO [FilePath]
getRecursiveContentsFullPath topdir = do
  names <- getDirectoryContents topdir
  let properNames = filter (`notElem` [".", ".."]) names
  paths <- forM properNames $ \name -> do
    let path = topdir </> name
    isDir <- doesDirectoryExist path
    if isDir
      then getRecursiveContentsFullPath path
      else return [path]
  return (concat paths)