997af79381e6745cd3aa88954a7b3d8f147bde76
[packages/filepath.git] / System / FilePath / Internal.hs
1 #if __GLASGOW_HASKELL__ >= 704
2 {-# LANGUAGE Safe #-}
3 #endif
4
5 -- This template expects CPP definitions for:
6 -- MODULE_NAME = Posix | Windows
7 -- IS_WINDOWS = False | True
8
9 -- |
10 -- Module : System.FilePath.MODULE_NAME
11 -- Copyright : (c) Neil Mitchell 2005-2014
12 -- License : BSD3
13 --
14 -- Maintainer : ndmitchell@gmail.com
15 -- Stability : stable
16 -- Portability : portable
17 --
18 -- A library for FilePath manipulations, using MODULE_NAME style paths on
19 -- all platforms. Importing "System.FilePath" is usually better.
20 --
21 -- Some short examples:
22 --
23 -- You are given a C file, you want to figure out the corresponding object (.o) file:
24 --
25 -- @'replaceExtension' file \"o\"@
26 --
27 -- Haskell module Main imports Test, you have the file named main:
28 --
29 -- @['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@
30 --
31 -- You want to download a file from the web and save it to disk:
32 --
33 -- @do let file = 'makeValid' url
34 -- System.IO.createDirectoryIfMissing True ('takeDirectory' file)@
35 --
36 -- You want to compile a Haskell file, but put the hi file under \"interface\"
37 --
38 -- @'takeDirectory' file '</>' \"interface\" '</>' ('takeFileName' file \`replaceExtension\` \"hi\"@)
39 --
40 -- The examples in code format descibed by each function are used to generate
41 -- tests, and should give clear semantics for the functions.
42 --
43 -- References:
44 -- [1] "Naming Files, Paths, and Namespaces"
45 -- http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx
46 -----------------------------------------------------------------------------
47
48 module System.FilePath.MODULE_NAME
49 (
50 -- * Separator predicates
51 FilePath,
52 pathSeparator, pathSeparators, isPathSeparator,
53 searchPathSeparator, isSearchPathSeparator,
54 extSeparator, isExtSeparator,
55
56 -- * Path methods (environment $PATH)
57 splitSearchPath, getSearchPath,
58
59 -- * Extension methods
60 splitExtension,
61 takeExtension, replaceExtension, dropExtension, addExtension, hasExtension, (<.>),
62 splitExtensions, dropExtensions, takeExtensions,
63
64 -- * Drive methods
65 splitDrive, joinDrive,
66 takeDrive, hasDrive, dropDrive, isDrive,
67
68 -- * Operations on a FilePath, as a list of directories
69 splitFileName,
70 takeFileName, replaceFileName, dropFileName,
71 takeBaseName, replaceBaseName,
72 takeDirectory, replaceDirectory,
73 combine, (</>),
74 splitPath, joinPath, splitDirectories,
75
76 -- * Low level FilePath operators
77 hasTrailingPathSeparator,
78 addTrailingPathSeparator,
79 dropTrailingPathSeparator,
80
81 -- * File name manipulators
82 normalise, equalFilePath,
83 makeRelative,
84 isRelative, isAbsolute,
85 isValid, makeValid
86 )
87 where
88
89 import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
90 import Data.Maybe(isJust, fromJust)
91
92 import System.Environment(getEnv)
93
94
95 infixr 7 <.>
96 infixr 5 </>
97
98
99
100
101
102 ---------------------------------------------------------------------
103 -- Platform Abstraction Methods (private)
104
105 -- | Is the operating system Unix or Linux like
106 isPosix :: Bool
107 isPosix = not isWindows
108
109 -- | Is the operating system Windows like
110 isWindows :: Bool
111 isWindows = IS_WINDOWS
112
113
114 ---------------------------------------------------------------------
115 -- The basic functions
116
117 -- | The character that separates directories. In the case where more than
118 -- one character is possible, 'pathSeparator' is the \'ideal\' one.
119 --
120 -- > Windows: pathSeparator == '\\'
121 -- > Posix: pathSeparator == '/'
122 -- > isPathSeparator pathSeparator
123 pathSeparator :: Char
124 pathSeparator = if isWindows then '\\' else '/'
125
126 -- | The list of all possible separators.
127 --
128 -- > Windows: pathSeparators == ['\\', '/']
129 -- > Posix: pathSeparators == ['/']
130 -- > pathSeparator `elem` pathSeparators
131 pathSeparators :: [Char]
132 pathSeparators = if isWindows then "\\/" else "/"
133
134 -- | Rather than using @(== 'pathSeparator')@, use this. Test if something
135 -- is a path separator.
136 --
137 -- > isPathSeparator a == (a `elem` pathSeparators)
138 isPathSeparator :: Char -> Bool
139 isPathSeparator = (`elem` pathSeparators)
140
141
142 -- | The character that is used to separate the entries in the $PATH environment variable.
143 --
144 -- > Windows: searchPathSeparator == ';'
145 -- > Posix: searchPathSeparator == ':'
146 searchPathSeparator :: Char
147 searchPathSeparator = if isWindows then ';' else ':'
148
149 -- | Is the character a file separator?
150 --
151 -- > isSearchPathSeparator a == (a == searchPathSeparator)
152 isSearchPathSeparator :: Char -> Bool
153 isSearchPathSeparator = (== searchPathSeparator)
154
155
156 -- | File extension character
157 --
158 -- > extSeparator == '.'
159 extSeparator :: Char
160 extSeparator = '.'
161
162 -- | Is the character an extension character?
163 --
164 -- > isExtSeparator a == (a == extSeparator)
165 isExtSeparator :: Char -> Bool
166 isExtSeparator = (== extSeparator)
167
168
169
170
171 ---------------------------------------------------------------------
172 -- Path methods (environment $PATH)
173
174 -- | Take a string, split it on the 'searchPathSeparator' character.
175 --
176 -- Follows the recommendations in
177 -- <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
178 --
179 -- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"]
180 -- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]
181 -- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"]
182 -- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]
183 splitSearchPath :: String -> [FilePath]
184 splitSearchPath = f
185 where
186 f xs = case break isSearchPathSeparator xs of
187 (pre, [] ) -> g pre
188 (pre, _:post) -> g pre ++ f post
189
190 g "" = ["." | isPosix]
191 g x = [x]
192
193
194 -- | Get a list of filepaths in the $PATH.
195 getSearchPath :: IO [FilePath]
196 getSearchPath = fmap splitSearchPath (getEnv "PATH")
197
198
199 ---------------------------------------------------------------------
200 -- Extension methods
201
202 -- | Split on the extension. 'addExtension' is the inverse.
203 --
204 -- > uncurry (++) (splitExtension x) == x
205 -- > uncurry addExtension (splitExtension x) == x
206 -- > splitExtension "file.txt" == ("file",".txt")
207 -- > splitExtension "file" == ("file","")
208 -- > splitExtension "file/file.txt" == ("file/file",".txt")
209 -- > splitExtension "file.txt/boris" == ("file.txt/boris","")
210 -- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")
211 -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
212 -- > splitExtension "file/path.txt/" == ("file/path.txt/","")
213 splitExtension :: FilePath -> (String, String)
214 splitExtension x = case d of
215 "" -> (x,"")
216 (y:ys) -> (a ++ reverse ys, y : reverse c)
217 where
218 (a,b) = splitFileName_ x
219 (c,d) = break isExtSeparator $ reverse b
220
221 -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
222 --
223 -- > takeExtension x == snd (splitExtension x)
224 -- > Valid x => takeExtension (addExtension x "ext") == ".ext"
225 -- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"
226 takeExtension :: FilePath -> String
227 takeExtension = snd . splitExtension
228
229 -- | Set the extension of a file, overwriting one if already present.
230 --
231 -- > replaceExtension "file.txt" ".bob" == "file.bob"
232 -- > replaceExtension "file.txt" "bob" == "file.bob"
233 -- > replaceExtension "file" ".bob" == "file.bob"
234 -- > replaceExtension "file.txt" "" == "file"
235 -- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"
236 replaceExtension :: FilePath -> String -> FilePath
237 replaceExtension x y = dropExtension x <.> y
238
239 -- | Alias to 'addExtension', for people who like that sort of thing.
240 (<.>) :: FilePath -> String -> FilePath
241 (<.>) = addExtension
242
243 -- | Remove last extension, and the \".\" preceding it.
244 --
245 -- > dropExtension x == fst (splitExtension x)
246 dropExtension :: FilePath -> FilePath
247 dropExtension = fst . splitExtension
248
249 -- | Add an extension, even if there is already one there.
250 -- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.
251 --
252 -- > addExtension "file.txt" "bib" == "file.txt.bib"
253 -- > addExtension "file." ".bib" == "file..bib"
254 -- > addExtension "file" ".bib" == "file.bib"
255 -- > addExtension "/" "x" == "/.x"
256 -- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
257 -- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
258 addExtension :: FilePath -> String -> FilePath
259 addExtension file "" = file
260 addExtension file xs@(x:_) = joinDrive a res
261 where
262 res = if isExtSeparator x then b ++ xs
263 else b ++ [extSeparator] ++ xs
264
265 (a,b) = splitDrive file
266
267 -- | Does the given filename have an extension?
268 --
269 -- > null (takeExtension x) == not (hasExtension x)
270 hasExtension :: FilePath -> Bool
271 hasExtension = any isExtSeparator . takeFileName
272
273
274 -- | Split on all extensions
275 --
276 -- > uncurry (++) (splitExtensions x) == x
277 -- > uncurry addExtension (splitExtensions x) == x
278 -- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
279 splitExtensions :: FilePath -> (FilePath, String)
280 splitExtensions x = (a ++ c, d)
281 where
282 (a,b) = splitFileName_ x
283 (c,d) = break isExtSeparator b
284
285 -- | Drop all extensions
286 --
287 -- > not $ hasExtension (dropExtensions x)
288 dropExtensions :: FilePath -> FilePath
289 dropExtensions = fst . splitExtensions
290
291 -- | Get all extensions
292 --
293 -- > takeExtensions "file.tar.gz" == ".tar.gz"
294 takeExtensions :: FilePath -> String
295 takeExtensions = snd . splitExtensions
296
297
298
299 ---------------------------------------------------------------------
300 -- Drive methods
301
302 -- | Is the given character a valid drive letter?
303 -- only a-z and A-Z are letters, not isAlpha which is more unicodey
304 isLetter :: Char -> Bool
305 isLetter x = isAsciiLower x || isAsciiUpper x
306
307
308 -- | Split a path into a drive and a path.
309 -- On Unix, \/ is a Drive.
310 --
311 -- > uncurry (++) (splitDrive x) == x
312 -- > Windows: splitDrive "file" == ("","file")
313 -- > Windows: splitDrive "c:/file" == ("c:/","file")
314 -- > Windows: splitDrive "c:\\file" == ("c:\\","file")
315 -- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")
316 -- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")
317 -- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")
318 -- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")
319 -- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")
320 -- > Windows: splitDrive "/d" == ("","/d")
321 -- > Posix: splitDrive "/test" == ("/","test")
322 -- > Posix: splitDrive "//test" == ("//","test")
323 -- > Posix: splitDrive "test/file" == ("","test/file")
324 -- > Posix: splitDrive "file" == ("","file")
325 splitDrive :: FilePath -> (FilePath, FilePath)
326 splitDrive x | isPosix = span (== '/') x
327
328 splitDrive x | isJust y = fromJust y
329 where y = readDriveLetter x
330
331 splitDrive x | isJust y = fromJust y
332 where y = readDriveUNC x
333
334 splitDrive x | isJust y = fromJust y
335 where y = readDriveShare x
336
337 splitDrive x = ("",x)
338
339 addSlash :: FilePath -> FilePath -> (FilePath, FilePath)
340 addSlash a xs = (a++c,d)
341 where (c,d) = span isPathSeparator xs
342
343 -- See [1].
344 -- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"
345 readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)
346 readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] =
347 case map toUpper xs of
348 ('U':'N':'C':s4:_) | isPathSeparator s4 ->
349 let (a,b) = readDriveShareName (drop 4 xs)
350 in Just (s1:s2:'?':s3:take 4 xs ++ a, b)
351 _ -> case readDriveLetter xs of
352 -- Extended-length path.
353 Just (a,b) -> Just (s1:s2:'?':s3:a,b)
354 Nothing -> Nothing
355 readDriveUNC _ = Nothing
356
357 {- c:\ -}
358 readDriveLetter :: String -> Maybe (FilePath, FilePath)
359 readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)
360 readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)
361 readDriveLetter _ = Nothing
362
363 {- \\sharename\ -}
364 readDriveShare :: String -> Maybe (FilePath, FilePath)
365 readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =
366 Just (s1:s2:a,b)
367 where (a,b) = readDriveShareName xs
368 readDriveShare _ = Nothing
369
370 {- assume you have already seen \\ -}
371 {- share\bob -> "share\", "bob" -}
372 readDriveShareName :: String -> (FilePath, FilePath)
373 readDriveShareName name = addSlash a b
374 where (a,b) = break isPathSeparator name
375
376
377
378 -- | Join a drive and the rest of the path.
379 --
380 -- > uncurry joinDrive (splitDrive x) == x
381 -- > Windows: joinDrive "C:" "foo" == "C:foo"
382 -- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"
383 -- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"
384 -- > Windows: joinDrive "/:" "foo" == "/:\\foo"
385 joinDrive :: FilePath -> FilePath -> FilePath
386 joinDrive a b | isPosix = a ++ b
387 | null a = b
388 | null b = a
389 | isPathSeparator (last a) = a ++ b
390 | otherwise = case a of
391 [a1,':'] | isLetter a1 -> a ++ b
392 _ -> a ++ [pathSeparator] ++ b
393
394 -- | Get the drive from a filepath.
395 --
396 -- > takeDrive x == fst (splitDrive x)
397 takeDrive :: FilePath -> FilePath
398 takeDrive = fst . splitDrive
399
400 -- | Delete the drive, if it exists.
401 --
402 -- > dropDrive x == snd (splitDrive x)
403 dropDrive :: FilePath -> FilePath
404 dropDrive = snd . splitDrive
405
406 -- | Does a path have a drive.
407 --
408 -- > not (hasDrive x) == null (takeDrive x)
409 -- > Posix: hasDrive "/foo" == True
410 -- > Windows: hasDrive "C:\\foo" == True
411 -- > Windows: hasDrive "C:foo" == True
412 -- > hasDrive "foo" == False
413 -- > hasDrive "" == False
414 hasDrive :: FilePath -> Bool
415 hasDrive = not . null . takeDrive
416
417
418 -- | Is an element a drive
419 --
420 -- > Posix: isDrive "/" == True
421 -- > Posix: isDrive "/foo" == False
422 -- > Windows: isDrive "C:\\" == True
423 -- > Windows: isDrive "C:\\foo" == False
424 -- > isDrive "" == False
425 isDrive :: FilePath -> Bool
426 isDrive x = not (null x) && null (dropDrive x)
427
428
429 ---------------------------------------------------------------------
430 -- Operations on a filepath, as a list of directories
431
432 -- | Split a filename into directory and file. 'combine' is the inverse.
433 --
434 -- > Valid x => uncurry (</>) (splitFileName x) == x || fst (splitFileName x) == "./"
435 -- > Posix: Valid x => isValid (fst (splitFileName x))
436 -- > splitFileName "file/bob.txt" == ("file/", "bob.txt")
437 -- > splitFileName "file/" == ("file/", "")
438 -- > splitFileName "bob" == ("./", "bob")
439 -- > Posix: splitFileName "/" == ("/","")
440 -- > Windows: splitFileName "c:" == ("c:","")
441 splitFileName :: FilePath -> (String, String)
442 splitFileName x = (if null dir then "./" else dir, name)
443 where
444 (dir, name) = splitFileName_ x
445
446 -- version of splitFileName where, if the FilePath has no directory
447 -- component, the returned directory is "" rather than "./". This
448 -- is used in cases where we are going to combine the returned
449 -- directory to make a valid FilePath, and having a "./" appear would
450 -- look strange and upset simple equality properties. See
451 -- e.g. replaceFileName.
452 splitFileName_ :: FilePath -> (String, String)
453 splitFileName_ x = (c ++ reverse b, reverse a)
454 where
455 (a,b) = break isPathSeparator $ reverse d
456 (c,d) = splitDrive x
457
458 -- | Set the filename.
459 --
460 -- > Valid x => replaceFileName x (takeFileName x) == x
461 replaceFileName :: FilePath -> String -> FilePath
462 replaceFileName x y = a </> y where (a,_) = splitFileName_ x
463
464 -- | Drop the filename.
465 --
466 -- > dropFileName x == fst (splitFileName x)
467 dropFileName :: FilePath -> FilePath
468 dropFileName = fst . splitFileName
469
470
471 -- | Get the file name.
472 --
473 -- > takeFileName "test/" == ""
474 -- > takeFileName x `isSuffixOf` x
475 -- > takeFileName x == snd (splitFileName x)
476 -- > Valid x => takeFileName (replaceFileName x "fred") == "fred"
477 -- > Valid x => takeFileName (x </> "fred") == "fred"
478 -- > Valid x => isRelative (takeFileName x)
479 takeFileName :: FilePath -> FilePath
480 takeFileName = snd . splitFileName
481
482 -- | Get the base name, without an extension or path.
483 --
484 -- > takeBaseName "file/test.txt" == "test"
485 -- > takeBaseName "dave.ext" == "dave"
486 -- > takeBaseName "" == ""
487 -- > takeBaseName "test" == "test"
488 -- > takeBaseName (addTrailingPathSeparator x) == ""
489 -- > takeBaseName "file/file.tar.gz" == "file.tar"
490 takeBaseName :: FilePath -> String
491 takeBaseName = dropExtension . takeFileName
492
493 -- | Set the base name.
494 --
495 -- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt"
496 -- > replaceBaseName "fred" "bill" == "bill"
497 -- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"
498 -- > Valid x => replaceBaseName x (takeBaseName x) == x
499 replaceBaseName :: FilePath -> String -> FilePath
500 replaceBaseName pth nam = combineAlways a (nam <.> ext)
501 where
502 (a,b) = splitFileName_ pth
503 ext = takeExtension b
504
505 -- | Is an item either a directory or the last character a path separator?
506 --
507 -- > hasTrailingPathSeparator "test" == False
508 -- > hasTrailingPathSeparator "test/" == True
509 hasTrailingPathSeparator :: FilePath -> Bool
510 hasTrailingPathSeparator "" = False
511 hasTrailingPathSeparator x = isPathSeparator (last x)
512
513
514 hasLeadingPathSeparator :: FilePath -> Bool
515 hasLeadingPathSeparator "" = False
516 hasLeadingPathSeparator x = isPathSeparator (head x)
517
518
519 -- | Add a trailing file path separator if one is not already present.
520 --
521 -- > hasTrailingPathSeparator (addTrailingPathSeparator x)
522 -- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x
523 -- > Posix: addTrailingPathSeparator "test/rest" == "test/rest/"
524 addTrailingPathSeparator :: FilePath -> FilePath
525 addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]
526
527
528 -- | Remove any trailing path separators
529 --
530 -- > dropTrailingPathSeparator "file/test/" == "file/test"
531 -- > dropTrailingPathSeparator "/" == "/"
532 -- > Windows: dropTrailingPathSeparator "\\" == "\\"
533 -- > Posix: not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
534 dropTrailingPathSeparator :: FilePath -> FilePath
535 dropTrailingPathSeparator x =
536 if hasTrailingPathSeparator x && not (isDrive x)
537 then let x' = reverse $ dropWhile isPathSeparator $ reverse x
538 in if null x' then [last x] else x'
539 else x
540
541
542 -- | Get the directory name, move up one level.
543 --
544 -- > takeDirectory x `isPrefixOf` x || takeDirectory x == "."
545 -- > takeDirectory "foo" == "."
546 -- > takeDirectory "/" == "/"
547 -- > takeDirectory "/foo" == "/"
548 -- > takeDirectory "/foo/bar/baz" == "/foo/bar"
549 -- > takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"
550 -- > takeDirectory "foo/bar/baz" == "foo/bar"
551 -- > Windows: takeDirectory "foo\\bar" == "foo"
552 -- > Windows: takeDirectory "foo\\bar\\\\" == "foo\\bar"
553 -- > Windows: takeDirectory "C:\\" == "C:\\"
554 takeDirectory :: FilePath -> FilePath
555 takeDirectory = dropTrailingPathSeparator . dropFileName
556
557 -- | Set the directory, keeping the filename the same.
558 --
559 -- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x
560 replaceDirectory :: FilePath -> String -> FilePath
561 replaceDirectory x dir = combineAlways dir (takeFileName x)
562
563
564 -- | Combine two paths, if the second path starts with a path separator or a
565 -- drive letter, then it returns the second.
566 --
567 -- > Valid x => combine (takeDirectory x) (takeFileName x) `equalFilePath` x
568 --
569 -- Combined:
570 -- > Posix: combine "/" "test" == "/test"
571 -- > Posix: combine "home" "bob" == "home/bob"
572 -- > Posix: combine "x:" "foo" == "x:/foo"
573 -- > Windows: combine "C:\\foo" "bar" == "C:\\foo\\bar"
574 -- > Windows: combine "home" "bob" == "home\\bob"
575 --
576 -- Not combined:
577 -- > Posix: combine "home" "/bob" == "/bob"
578 -- > Windows: combine "home" "C:\\bob" == "C:\\bob"
579 --
580 -- Not combined (tricky):
581 -- On Windows, if a filepath starts with a single slash, it is relative to the
582 -- root of the current drive. In [1], this is (confusingly) referred to as an
583 -- absolute path.
584 -- The current behavior of @combine@ is to never combine these forms.
585 --
586 -- > Windows: combine "home" "/bob" == "/bob"
587 -- > Windows: combine "home" "\\bob" == "\\bob"
588 -- > Windows: combine "C:\\home" "\\bob" == "\\bob"
589 --
590 -- On Windows, from [1]: "If a file name begins with only a disk designator
591 -- but not the backslash after the colon, it is interpreted as a relative path
592 -- to the current directory on the drive with the specified letter."
593 -- The current behavior of @combine@ is to never combine these forms.
594 --
595 -- > Windows: combine "D:\\foo" "C:bar" == "C:bar"
596 -- > Windows: combine "C:\\foo" "C:bar" == "C:bar"
597 combine :: FilePath -> FilePath -> FilePath
598 combine a b | hasLeadingPathSeparator b || hasDrive b = b
599 | otherwise = combineAlways a b
600
601 -- | Combine two paths, assuming rhs is NOT absolute.
602 combineAlways :: FilePath -> FilePath -> FilePath
603 combineAlways a b | null a = b
604 | null b = a
605 | isPathSeparator (last a) = a ++ b
606 | isDrive a = joinDrive a b
607 | otherwise = a ++ [pathSeparator] ++ b
608
609
610 -- | A nice alias for 'combine'.
611 (</>) :: FilePath -> FilePath -> FilePath
612 (</>) = combine
613
614
615 -- | Split a path by the directory separator.
616 --
617 -- > concat (splitPath x) == x
618 -- > splitPath "test//item/" == ["test//","item/"]
619 -- > splitPath "test/item/file" == ["test/","item/","file"]
620 -- > splitPath "" == []
621 -- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"]
622 -- > Posix: splitPath "/file/test" == ["/","file/","test"]
623 splitPath :: FilePath -> [FilePath]
624 splitPath x = [drive | drive /= ""] ++ f path
625 where
626 (drive,path) = splitDrive x
627
628 f "" = []
629 f y = (a++c) : f d
630 where
631 (a,b) = break isPathSeparator y
632 (c,d) = span isPathSeparator b
633
634 -- | Just as 'splitPath', but don't add the trailing slashes to each element.
635 --
636 -- > splitDirectories "test/file" == ["test","file"]
637 -- > splitDirectories "/test/file" == ["/","test","file"]
638 -- > Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]
639 -- > Posix: Valid x => joinPath (splitDirectories x) `equalFilePath` x
640 -- > splitDirectories "" == []
641 splitDirectories :: FilePath -> [FilePath]
642 splitDirectories = map dropTrailingPathSeparator . splitPath
643
644
645 -- | Join path elements back together.
646 --
647 -- > Valid x => joinPath (splitPath x) == x
648 -- > joinPath [] == ""
649 -- > Posix: joinPath ["test","file","path"] == "test/file/path"
650
651 -- Note that this definition on c:\\c:\\, join then split will give c:\\.
652 joinPath :: [FilePath] -> FilePath
653 joinPath = foldr combine ""
654
655
656
657
658
659
660 ---------------------------------------------------------------------
661 -- File name manipulators
662
663 -- | Equality of two 'FilePath's.
664 -- If you call @System.Directory.canonicalizePath@
665 -- first this has a much better chance of working.
666 -- Note that this doesn't follow symlinks or DOSNAM~1s.
667 --
668 -- > x == y ==> equalFilePath x y
669 -- > normalise x == normalise y ==> equalFilePath x y
670 -- > equalFilePath "foo" "foo/"
671 -- > not (equalFilePath "foo" "/foo")
672 -- > Posix: not (equalFilePath "foo" "FOO")
673 -- > Windows: equalFilePath "foo" "FOO"
674 -- > Windows: not (equalFilePath "C:" "C:/")
675 equalFilePath :: FilePath -> FilePath -> Bool
676 equalFilePath a b = f a == f b
677 where
678 f x | isWindows = dropTrailingPathSeparator $ map toLower $ normalise x
679 | otherwise = dropTrailingPathSeparator $ normalise x
680
681
682 -- | Contract a filename, based on a relative path.
683 --
684 -- There is no corresponding @makeAbsolute@ function, instead use
685 -- @System.Directory.canonicalizePath@ which has the same effect.
686 --
687 -- > makeRelative x x == "."
688 -- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"
689 -- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob"
690 -- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"
691 -- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"
692 -- > Windows: makeRelative "/Home" "/home/bob" == "bob"
693 -- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob"
694 -- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
695 -- > Posix: makeRelative "/fred" "bob" == "bob"
696 -- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred"
697 -- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/"
698 -- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
699 makeRelative :: FilePath -> FilePath -> FilePath
700 makeRelative root path
701 | equalFilePath root path = "."
702 | takeAbs root /= takeAbs path = path
703 | otherwise = f (dropAbs root) (dropAbs path)
704 where
705 f "" y = dropWhile isPathSeparator y
706 f x y = let (x1,x2) = g x
707 (y1,y2) = g y
708 in if equalFilePath x1 y1 then f x2 y2 else path
709
710 g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)
711 where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
712
713 -- on windows, need to drop '/' which is kind of absolute, but not a drive
714 dropAbs (x:xs) | isPathSeparator x = xs
715 dropAbs x = dropDrive x
716
717 takeAbs (x:_) | isPathSeparator x = [pathSeparator]
718 takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
719
720 -- | Normalise a file
721 --
722 -- * \/\/ outside of the drive can be made blank
723 --
724 -- * \/ -> 'pathSeparator'
725 --
726 -- * .\/ -> \"\"
727 --
728 -- > Posix: normalise "/file/\\test////" == "/file/\\test/"
729 -- > Posix: normalise "/file/./test" == "/file/test"
730 -- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"
731 -- > Posix: normalise "../bob/fred/" == "../bob/fred/"
732 -- > Posix: normalise "./bob/fred/" == "bob/fred/"
733 -- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
734 -- > Windows: normalise "c:\\" == "C:\\"
735 -- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"
736 -- > Windows: normalise "c:/file" == "C:\\file"
737 -- > normalise "." == "."
738 -- > Posix: normalise "./" == "./"
739 -- > Posix: normalise "./." == "./"
740 -- > Posix: normalise "/" == "/"
741 -- > Posix: normalise "bob/fred/." == "bob/fred/"
742 normalise :: FilePath -> FilePath
743 normalise path = joinDrive' (normaliseDrive drv) (f pth)
744 ++ [pathSeparator | isDirPath pth]
745 where
746 (drv,pth) = splitDrive path
747
748 joinDrive' "" "" = "."
749 joinDrive' d p = joinDrive d p
750
751 isDirPath xs = hasTrailingPathSeparator xs
752 || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
753
754 f = joinPath . dropDots . splitDirectories . propSep
755
756 propSep (a:b:xs)
757 | isPathSeparator a && isPathSeparator b = propSep (a:xs)
758 propSep (a:xs)
759 | isPathSeparator a = pathSeparator : propSep xs
760 propSep (x:xs) = x : propSep xs
761 propSep [] = []
762
763 dropDots = filter ("." /=)
764
765 normaliseDrive :: FilePath -> FilePath
766 normaliseDrive drive | isPosix = drive
767 normaliseDrive drive = if isJust $ readDriveLetter x2
768 then map toUpper x2
769 else drive
770 where
771 x2 = map repSlash drive
772
773 repSlash x = if isPathSeparator x then pathSeparator else x
774
775 -- Information for validity functions on Windows. See [1].
776 badCharacters :: [Char]
777 badCharacters = ":*?><|\""
778 badElements :: [FilePath]
779 badElements = ["CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9", "CLOCK$"]
780
781
782 -- | Is a FilePath valid, i.e. could you create a file like it?
783 --
784 -- > isValid "" == False
785 -- > Posix: isValid "/random_ path:*" == True
786 -- > Posix: isValid x == not (null x)
787 -- > Windows: isValid "c:\\test" == True
788 -- > Windows: isValid "c:\\test:of_test" == False
789 -- > Windows: isValid "test*" == False
790 -- > Windows: isValid "c:\\test\\nul" == False
791 -- > Windows: isValid "c:\\test\\prn.txt" == False
792 -- > Windows: isValid "c:\\nul\\file" == False
793 -- > Windows: isValid "\\\\" == False
794 -- > Windows: isValid "\\\\\\foo" == False
795 isValid :: FilePath -> Bool
796 isValid "" = False
797 isValid _ | isPosix = True
798 isValid path =
799 not (any (`elem` badCharacters) x2) &&
800 not (any f $ splitDirectories x2) &&
801 not (length x1 >= 2 && all isPathSeparator x1)
802 where
803 x1 = head (splitPath path)
804 x2 = dropDrive path
805 f x = map toUpper (dropExtensions x) `elem` badElements
806
807
808 -- | Take a FilePath and make it valid; does not change already valid FilePaths.
809 --
810 -- > isValid (makeValid x)
811 -- > isValid x ==> makeValid x == x
812 -- > makeValid "" == "_"
813 -- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid"
814 -- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"
815 -- > Windows: makeValid "test*" == "test_"
816 -- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"
817 -- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"
818 -- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
819 -- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
820 -- > Windows: makeValid "\\\\\\foo" == "\\\\drive"
821 makeValid :: FilePath -> FilePath
822 makeValid "" = "_"
823 makeValid path | isPosix = path
824 makeValid xs | length x >= 2 && all isPathSeparator x = take 2 x ++ "drive"
825 where
826 x = head (splitPath xs)
827 makeValid path = joinDrive drv $ validElements $ validChars pth
828 where
829 (drv,pth) = splitDrive path
830
831 validChars = map f
832 f x | x `elem` badCharacters = '_'
833 | otherwise = x
834
835 validElements x = joinPath $ map g $ splitPath x
836 g x = h a ++ b
837 where (a,b) = break isPathSeparator x
838 h x = if map toUpper a `elem` badElements then a ++ "_" <.> b else x
839 where (a,b) = splitExtensions x
840
841
842 -- | Is a path relative, or is it fixed to the root?
843 --
844 -- > Windows: isRelative "path\\test" == True
845 -- > Windows: isRelative "c:\\test" == False
846 -- > Windows: isRelative "c:test" == True
847 -- > Windows: isRelative "c:\\" == False
848 -- > Windows: isRelative "c:/" == False
849 -- > Windows: isRelative "c:" == True
850 -- > Windows: isRelative "\\\\foo" == False
851 -- > Windows: isRelative "\\\\?\\foo" == False
852 -- > Windows: isRelative "\\\\?\\UNC\\foo" == False
853 -- > Windows: isRelative "/foo" == True
854 -- > Windows: isRelative "\\foo" == True
855 -- > Posix: isRelative "test/path" == True
856 -- > Posix: isRelative "/test" == False
857 -- > Posix: isRelative "/" == False
858 --
859 -- According to [1]:
860 --
861 -- * "A UNC name of any format [is never relative]."
862 --
863 -- * "You cannot use the "\\?\" prefix with a relative path."
864 isRelative :: FilePath -> Bool
865 isRelative = isRelativeDrive . takeDrive
866
867
868 {- c:foo -}
869 -- From [1]: "If a file name begins with only a disk designator but not the
870 -- backslash after the colon, it is interpreted as a relative path to the
871 -- current directory on the drive with the specified letter."
872 isRelativeDrive :: String -> Bool
873 isRelativeDrive x = null x ||
874 maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x)
875
876
877 -- | @not . 'isRelative'@
878 --
879 -- > isAbsolute x == not (isRelative x)
880 isAbsolute :: FilePath -> Bool
881 isAbsolute = not . isRelative