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
122
123
124
125
126
127
128
129
130
131
132
133
|
{- directory manipulation
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.Directory where
import System.IO.Error
import System.Posix.Files
import System.Directory
import Control.Exception (throw, bracket_)
import Control.Monad
import Control.Monad.IfElse
import System.FilePath
import Control.Applicative
import System.Posix.Directory
import System.IO.Unsafe (unsafeInterleaveIO)
import Utility.SafeCommand
import Utility.TempFile
import Utility.Exception
import Utility.Monad
import Utility.Path
dirCruft :: FilePath -> Bool
dirCruft "." = True
dirCruft ".." = True
dirCruft _ = False
{- Lists the contents of a directory.
- Unlike getDirectoryContents, paths are not relative to the directory. -}
dirContents :: FilePath -> IO [FilePath]
dirContents d = map (d </>) . filter (not . dirCruft) <$> getDirectoryContents d
{- Gets files in a directory, and then its subdirectories, recursively,
- and lazily. -}
dirContentsRecursive :: FilePath -> IO [FilePath]
dirContentsRecursive topdir = dirContentsRecursive' topdir [""]
dirContentsRecursive' :: FilePath -> [FilePath] -> IO [FilePath]
dirContentsRecursive' _ [] = return []
dirContentsRecursive' topdir (dir:dirs) = unsafeInterleaveIO $ do
(files, dirs') <- collect [] [] =<< dirContents (topdir </> dir)
files' <- dirContentsRecursive' topdir (dirs' ++ dirs)
return (files ++ files')
where
collect files dirs' [] = return (reverse files, reverse dirs')
collect files dirs' (entry:entries)
| dirCruft entry = collect files dirs' entries
| otherwise = do
let dirEntry = dir </> entry
ifM (doesDirectoryExist $ topdir </> dirEntry)
( collect files (dirEntry:dirs') entries
, collect (dirEntry:files) dirs' entries
)
{- Gets the subdirectories in a directory, and their subdirectories,
- recursively, and lazily. Prunes sections of the tree matching a
- condition. -}
dirTree :: FilePath -> (FilePath -> Bool) -> IO [FilePath]
dirTree topdir prune
| prune topdir = return []
| otherwise = (:) topdir <$> dirTree' topdir prune [""]
dirTree' :: FilePath -> (FilePath -> Bool) -> [FilePath] -> IO [FilePath]
dirTree' _ _ [] = return []
dirTree' topdir prune (dir:dirs)
| prune dir = dirTree' topdir prune dirs
| otherwise = unsafeInterleaveIO $ do
subdirs <- collect [] =<< dirContents (topdir </> dir)
subdirs' <- dirTree' topdir prune (subdirs ++ dirs)
return $ subdirs ++ subdirs'
where
collect dirs' [] = return dirs'
collect dirs' (entry:entries)
| dirCruft entry || prune entry = collect dirs' entries
| otherwise = do
let dirEntry = dir </> entry
ifM (doesDirectoryExist $ topdir </> dirEntry)
( collect (dirEntry:dirs') entries
, collect dirs' entries
)
{- Moves one filename to another.
- First tries a rename, but falls back to moving across devices if needed. -}
moveFile :: FilePath -> FilePath -> IO ()
moveFile src dest = tryIO (rename src dest) >>= onrename
where
onrename (Right _) = noop
onrename (Left e)
| isPermissionError e = rethrow
| isDoesNotExistError e = rethrow
| otherwise = do
-- copyFile is likely not as optimised as
-- the mv command, so we'll use the latter.
-- But, mv will move into a directory if
-- dest is one, which is not desired.
whenM (isdir dest) rethrow
viaTmp mv dest undefined
where
rethrow = throw e
mv tmp _ = do
ok <- boolSystem "mv" [Param "-f",
Param src, Param tmp]
unless ok $ do
-- delete any partial
_ <- tryIO $ removeFile tmp
rethrow
isdir f = do
r <- tryIO $ getFileStatus f
case r of
(Left _) -> return False
(Right s) -> return $ isDirectory s
{- Removes a file, which may or may not exist.
-
- Note that an exception is thrown if the file exists but
- cannot be removed. -}
nukeFile :: FilePath -> IO ()
nukeFile file = whenM (doesFileExist file) $ removeFile file
{- Runs an action in another directory. -}
bracketCd :: FilePath -> IO a -> IO a
bracketCd dir a = go =<< getCurrentDirectory
where
go cwd
| dirContains dir cwd = a
| otherwise = bracket_
(changeWorkingDirectory dir)
(changeWorkingDirectory cwd)
a
|
