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
|
{- path manipulation
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Utility.Path where
import Data.String.Utils
import System.Path
import System.FilePath
import System.Directory
import Data.List
import Data.Maybe
import Control.Applicative
{- Returns the parent directory of a path. Parent of / is "" -}
parentDir :: FilePath -> FilePath
parentDir dir =
if not $ null dirs
then slash ++ join s (init dirs)
else ""
where
dirs = filter (not . null) $ split s dir
slash = if isAbsolute dir then s else ""
s = [pathSeparator]
prop_parentDir_basics :: FilePath -> Bool
prop_parentDir_basics dir
| null dir = True
| dir == "/" = parentDir dir == ""
| otherwise = p /= dir
where
p = parentDir dir
{- Checks if the first FilePath is, or could be said to contain the second.
- For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
- are all equivilant.
-}
dirContains :: FilePath -> FilePath -> Bool
dirContains a b = a == b || a' == b' || (a'++"/") `isPrefixOf` b'
where
norm p = fromMaybe "" $ absNormPath p "."
a' = norm a
b' = norm b
{- Converts a filename into a normalized, absolute path. -}
absPath :: FilePath -> IO FilePath
absPath file = do
cwd <- getCurrentDirectory
return $ absPathFrom cwd file
{- Converts a filename into a normalized, absolute path
- from the specified cwd. -}
absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom cwd file = fromMaybe bad $ absNormPath cwd file
where
bad = error $ "unable to normalize " ++ file
{- Constructs a relative path from the CWD to a file.
-
- For example, assuming CWD is /tmp/foo/bar:
- relPathCwdToFile "/tmp/foo" == ".."
- relPathCwdToFile "/tmp/foo/bar" == ""
-}
relPathCwdToFile :: FilePath -> IO FilePath
relPathCwdToFile f = relPathDirToFile <$> getCurrentDirectory <*> absPath f
{- Constructs a relative path from a directory to a file.
-
- Both must be absolute, and normalized (eg with absNormpath).
-}
relPathDirToFile :: FilePath -> FilePath -> FilePath
relPathDirToFile from to = path
where
s = [pathSeparator]
pfrom = split s from
pto = split s to
common = map fst $ filter same $ zip pfrom pto
same (c,d) = c == d
uncommon = drop numcommon pto
dotdots = replicate (length pfrom - numcommon) ".."
numcommon = length common
path = join s $ dotdots ++ uncommon
prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics from to
| from == to = null r
| otherwise = not (null r)
where
r = relPathDirToFile from to
{- Given an original list of files, and an expanded list derived from it,
- ensures that the original list's ordering is preserved.
-
- The input list may contain a directory, like "dir" or "dir/". Any
- items in the expanded list that are contained in that directory will
- appear at the same position as it did in the input list.
-}
preserveOrder :: [FilePath] -> [FilePath] -> [FilePath]
-- optimisation, only one item in original list, so no reordering needed
preserveOrder [_] new = new
preserveOrder orig new = collect orig new
where
collect [] n = n
collect [_] n = n -- optimisation
collect (l:ls) n = found ++ collect ls rest
where (found, rest)=partition (l `dirContains`) n
{- Runs an action that takes a list of FilePaths, and ensures that
- its return list preserves order.
-
- This assumes that it's cheaper to call preserveOrder on the result,
- than it would be to run the action separately with each param. In the case
- of git file list commands, that assumption tends to hold.
-}
runPreserveOrder :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
runPreserveOrder a files = preserveOrder files <$> a files
|
