#25, comment out another test
[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 import Data.List(isPrefixOf)
92
93 import System.Environment(getEnv)
94
95
96 infixr 7 <.>
97 infixr 5 </>
98
99
100
101
102
103 ---------------------------------------------------------------------
104 -- Platform Abstraction Methods (private)
105
106 -- | Is the operating system Unix or Linux like
107 isPosix :: Bool
108 isPosix = not isWindows
109
110 -- | Is the operating system Windows like
111 isWindows :: Bool
112 isWindows = IS_WINDOWS
113
114
115 ---------------------------------------------------------------------
116 -- The basic functions
117
118 -- | The character that separates directories. In the case where more than
119 -- one character is possible, 'pathSeparator' is the \'ideal\' one.
120 --
121 -- > Windows: pathSeparator == '\\'
122 -- > Posix: pathSeparator == '/'
123 -- > isPathSeparator pathSeparator
124 pathSeparator :: Char
125 pathSeparator = if isWindows then '\\' else '/'
126
127 -- | The list of all possible separators.
128 --
129 -- > Windows: pathSeparators == ['\\', '/']
130 -- > Posix: pathSeparators == ['/']
131 -- > pathSeparator `elem` pathSeparators
132 pathSeparators :: [Char]
133 pathSeparators = if isWindows then "\\/" else "/"
134
135 -- | Rather than using @(== 'pathSeparator')@, use this. Test if something
136 -- is a path separator.
137 --
138 -- > isPathSeparator a == (a `elem` pathSeparators)
139 isPathSeparator :: Char -> Bool
140 isPathSeparator = (`elem` pathSeparators)
141
142
143 -- | The character that is used to separate the entries in the $PATH environment variable.
144 --
145 -- > Windows: searchPathSeparator == ';'
146 -- > Posix: searchPathSeparator == ':'
147 searchPathSeparator :: Char
148 searchPathSeparator = if isWindows then ';' else ':'
149
150 -- | Is the character a file separator?
151 --
152 -- > isSearchPathSeparator a == (a == searchPathSeparator)
153 isSearchPathSeparator :: Char -> Bool
154 isSearchPathSeparator = (== searchPathSeparator)
155
156
157 -- | File extension character
158 --
159 -- > extSeparator == '.'
160 extSeparator :: Char
161 extSeparator = '.'
162
163 -- | Is the character an extension character?
164 --
165 -- > isExtSeparator a == (a == extSeparator)
166 isExtSeparator :: Char -> Bool
167 isExtSeparator = (== extSeparator)
168
169
170
171
172 ---------------------------------------------------------------------
173 -- Path methods (environment $PATH)
174
175 -- | Take a string, split it on the 'searchPathSeparator' character.
176 --
177 -- Follows the recommendations in
178 -- <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
179 --
180 -- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"]
181 -- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]
182 -- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"]
183 -- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]
184 splitSearchPath :: String -> [FilePath]
185 splitSearchPath = f
186 where
187 f xs = case break isSearchPathSeparator xs of
188 (pre, [] ) -> g pre
189 (pre, _:post) -> g pre ++ f post
190
191 g "" = ["." | isPosix]
192 g x = [x]
193
194
195 -- | Get a list of filepaths in the $PATH.
196 getSearchPath :: IO [FilePath]
197 getSearchPath = fmap splitSearchPath (getEnv "PATH")
198
199
200 ---------------------------------------------------------------------
201 -- Extension methods
202
203 -- | Split on the extension. 'addExtension' is the inverse.
204 --
205 -- > uncurry (++) (splitExtension x) == x
206 -- > uncurry addExtension (splitExtension x) == x
207 -- > splitExtension "file.txt" == ("file",".txt")
208 -- > splitExtension "file" == ("file","")
209 -- > splitExtension "file/file.txt" == ("file/file",".txt")
210 -- > splitExtension "file.txt/boris" == ("file.txt/boris","")
211 -- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")
212 -- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
213 -- > splitExtension "file/path.txt/" == ("file/path.txt/","")
214 splitExtension :: FilePath -> (String, String)
215 splitExtension x = case d of
216 "" -> (x,"")
217 (y:ys) -> (a ++ reverse ys, y : reverse c)
218 where
219 (a,b) = splitFileName_ x
220 (c,d) = break isExtSeparator $ reverse b
221
222 -- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
223 --
224 -- > takeExtension x == snd (splitExtension x)
225 -- > Valid x => takeExtension (addExtension x "ext") == ".ext"
226 -- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"
227 takeExtension :: FilePath -> String
228 takeExtension = snd . splitExtension
229
230 -- | Set the extension of a file, overwriting one if already present.
231 --
232 -- > replaceExtension "file.txt" ".bob" == "file.bob"
233 -- > replaceExtension "file.txt" "bob" == "file.bob"
234 -- > replaceExtension "file" ".bob" == "file.bob"
235 -- > replaceExtension "file.txt" "" == "file"
236 -- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"
237 replaceExtension :: FilePath -> String -> FilePath
238 replaceExtension x y = dropExtension x <.> y
239
240 -- | Alias to 'addExtension', for people who like that sort of thing.
241 (<.>) :: FilePath -> String -> FilePath
242 (<.>) = addExtension
243
244 -- | Remove last extension, and the \".\" preceding it.
245 --
246 -- > dropExtension x == fst (splitExtension x)
247 dropExtension :: FilePath -> FilePath
248 dropExtension = fst . splitExtension
249
250 -- | Add an extension, even if there is already one there.
251 -- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.
252 --
253 -- > addExtension "file.txt" "bib" == "file.txt.bib"
254 -- > addExtension "file." ".bib" == "file..bib"
255 -- > addExtension "file" ".bib" == "file.bib"
256 -- > addExtension "/" "x" == "/.x"
257 -- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
258 -- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
259 addExtension :: FilePath -> String -> FilePath
260 addExtension file "" = file
261 addExtension file xs@(x:_) = joinDrive a res
262 where
263 res = if isExtSeparator x then b ++ xs
264 else b ++ [extSeparator] ++ xs
265
266 (a,b) = splitDrive file
267
268 -- | Does the given filename have an extension?
269 --
270 -- > null (takeExtension x) == not (hasExtension x)
271 hasExtension :: FilePath -> Bool
272 hasExtension = any isExtSeparator . takeFileName
273
274
275 -- | Split on all extensions
276 --
277 -- > uncurry (++) (splitExtensions x) == x
278 -- > uncurry addExtension (splitExtensions x) == x
279 -- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
280 splitExtensions :: FilePath -> (FilePath, String)
281 splitExtensions x = (a ++ c, d)
282 where
283 (a,b) = splitFileName_ x
284 (c,d) = break isExtSeparator b
285
286 -- | Drop all extensions
287 --
288 -- > not $ hasExtension (dropExtensions x)
289 dropExtensions :: FilePath -> FilePath
290 dropExtensions = fst . splitExtensions
291
292 -- | Get all extensions
293 --
294 -- > takeExtensions "file.tar.gz" == ".tar.gz"
295 takeExtensions :: FilePath -> String
296 takeExtensions = snd . splitExtensions
297
298
299
300 ---------------------------------------------------------------------
301 -- Drive methods
302
303 -- | Is the given character a valid drive letter?
304 -- only a-z and A-Z are letters, not isAlpha which is more unicodey
305 isLetter :: Char -> Bool
306 isLetter x = isAsciiLower x || isAsciiUpper x
307
308
309 -- | Split a path into a drive and a path.
310 -- On Unix, \/ is a Drive.
311 --
312 -- > uncurry (++) (splitDrive x) == x
313 -- > Windows: splitDrive "file" == ("","file")
314 -- > Windows: splitDrive "c:/file" == ("c:/","file")
315 -- > Windows: splitDrive "c:\\file" == ("c:\\","file")
316 -- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")
317 -- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")
318 -- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")
319 -- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")
320 -- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")
321 -- > Windows: splitDrive "/d" == ("","/d")
322 -- > Posix: splitDrive "/test" == ("/","test")
323 -- > Posix: splitDrive "//test" == ("//","test")
324 -- > Posix: splitDrive "test/file" == ("","test/file")
325 -- > Posix: splitDrive "file" == ("","file")
326 splitDrive :: FilePath -> (FilePath, FilePath)
327 splitDrive x | isPosix = span (== '/') x
328
329 splitDrive x | isJust y = fromJust y
330 where y = readDriveLetter x
331
332 splitDrive x | isJust y = fromJust y
333 where y = readDriveUNC x
334
335 splitDrive x | isJust y = fromJust y
336 where y = readDriveShare x
337
338 splitDrive x = ("",x)
339
340 addSlash :: FilePath -> FilePath -> (FilePath, FilePath)
341 addSlash a xs = (a++c,d)
342 where (c,d) = span isPathSeparator xs
343
344 -- See [1].
345 -- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"
346 readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)
347 readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] =
348 case map toUpper xs of
349 ('U':'N':'C':s4:_) | isPathSeparator s4 ->
350 let (a,b) = readDriveShareName (drop 4 xs)
351 in Just (s1:s2:'?':s3:take 4 xs ++ a, b)
352 _ -> case readDriveLetter xs of
353 -- Extended-length path.
354 Just (a,b) -> Just (s1:s2:'?':s3:a,b)
355 Nothing -> Nothing
356 readDriveUNC _ = Nothing
357
358 {- c:\ -}
359 readDriveLetter :: String -> Maybe (FilePath, FilePath)
360 readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)
361 readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)
362 readDriveLetter _ = Nothing
363
364 {- \\sharename\ -}
365 readDriveShare :: String -> Maybe (FilePath, FilePath)
366 readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =
367 Just (s1:s2:a,b)
368 where (a,b) = readDriveShareName xs
369 readDriveShare _ = Nothing
370
371 {- assume you have already seen \\ -}
372 {- share\bob -> "share\", "bob" -}
373 readDriveShareName :: String -> (FilePath, FilePath)
374 readDriveShareName name = addSlash a b
375 where (a,b) = break isPathSeparator name
376
377
378
379 -- | Join a drive and the rest of the path.
380 --
381 -- > uncurry joinDrive (splitDrive x) == x
382 -- > Windows: joinDrive "C:" "foo" == "C:foo"
383 -- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"
384 -- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"
385 -- > Windows: joinDrive "/:" "foo" == "/:\\foo"
386 joinDrive :: FilePath -> FilePath -> FilePath
387 joinDrive a b | isPosix = a ++ b
388 | null a = b
389 | null b = a
390 | isPathSeparator (last a) = a ++ b
391 | otherwise = case a of
392 [a1,':'] | isLetter a1 -> a ++ b
393 _ -> a ++ [pathSeparator] ++ b
394
395 -- | Get the drive from a filepath.
396 --
397 -- > takeDrive x == fst (splitDrive x)
398 takeDrive :: FilePath -> FilePath
399 takeDrive = fst . splitDrive
400
401 -- | Delete the drive, if it exists.
402 --
403 -- > dropDrive x == snd (splitDrive x)
404 dropDrive :: FilePath -> FilePath
405 dropDrive = snd . splitDrive
406
407 -- | Does a path have a drive.
408 --
409 -- > not (hasDrive x) == null (takeDrive x)
410 -- > Posix: hasDrive "/foo" == True
411 -- > Windows: hasDrive "C:\\foo" == True
412 -- > Windows: hasDrive "C:foo" == True
413 -- > hasDrive "foo" == False
414 -- > hasDrive "" == False
415 hasDrive :: FilePath -> Bool
416 hasDrive = not . null . takeDrive
417
418
419 -- | Is an element a drive
420 --
421 -- > Posix: isDrive "/" == True
422 -- > Posix: isDrive "/foo" == False
423 -- > Windows: isDrive "C:\\" == True
424 -- > Windows: isDrive "C:\\foo" == False
425 isDrive :: FilePath -> Bool
426 isDrive = null . dropDrive
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 x = if isDrive file || (null res && not (null file)) then file else res
556 where
557 res = reverse $ dropWhile isPathSeparator $ reverse file
558 file = dropFileName x
559 _ = isPrefixOf x -- warning suppression
560
561 -- | Set the directory, keeping the filename the same.
562 --
563 -- > Valid x => replaceDirectory x (takeDirectory x) `equalFilePath` x
564 replaceDirectory :: FilePath -> String -> FilePath
565 replaceDirectory x dir = combineAlways dir (takeFileName x)
566
567
568 -- | Combine two paths, if the second path starts with a path separator or a
569 -- drive letter, then it returns the second.
570 --
571 -- > Valid x => combine (takeDirectory x) (takeFileName x) `equalFilePath` x
572 --
573 -- Combined:
574 -- > Posix: combine "/" "test" == "/test"
575 -- > Posix: combine "home" "bob" == "home/bob"
576 -- > Posix: combine "x:" "foo" == "x:/foo"
577 -- > Windows: combine "C:\\foo" "bar" == "C:\\foo\\bar"
578 -- > Windows: combine "home" "bob" == "home\\bob"
579 --
580 -- Not combined:
581 -- > Posix: combine "home" "/bob" == "/bob"
582 -- > Windows: combine "home" "C:\\bob" == "C:\\bob"
583 --
584 -- Not combined (tricky):
585 -- On Windows, if a filepath starts with a single slash, it is relative to the
586 -- root of the current drive. In [1], this is (confusingly) referred to as an
587 -- absolute path.
588 -- The current behavior of @combine@ is to never combine these forms.
589 --
590 -- > Windows: combine "home" "/bob" == "/bob"
591 -- > Windows: combine "home" "\\bob" == "\\bob"
592 -- > Windows: combine "C:\\home" "\\bob" == "\\bob"
593 --
594 -- On Windows, from [1]: "If a file name begins with only a disk designator
595 -- but not the backslash after the colon, it is interpreted as a relative path
596 -- to the current directory on the drive with the specified letter."
597 -- The current behavior of @combine@ is to never combine these forms.
598 --
599 -- > Windows: combine "D:\\foo" "C:bar" == "C:bar"
600 -- > Windows: combine "C:\\foo" "C:bar" == "C:bar"
601 combine :: FilePath -> FilePath -> FilePath
602 combine a b | hasLeadingPathSeparator b || hasDrive b = b
603 | otherwise = combineAlways a b
604
605 -- | Combine two paths, assuming rhs is NOT absolute.
606 combineAlways :: FilePath -> FilePath -> FilePath
607 combineAlways a b | null a = b
608 | null b = a
609 | isPathSeparator (last a) = a ++ b
610 | isDrive a = joinDrive a b
611 | otherwise = a ++ [pathSeparator] ++ b
612
613
614 -- | A nice alias for 'combine'.
615 (</>) :: FilePath -> FilePath -> FilePath
616 (</>) = combine
617
618
619 -- | Split a path by the directory separator.
620 --
621 -- > concat (splitPath x) == x
622 -- > splitPath "test//item/" == ["test//","item/"]
623 -- > splitPath "test/item/file" == ["test/","item/","file"]
624 -- > splitPath "" == []
625 -- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"]
626 -- > Posix: splitPath "/file/test" == ["/","file/","test"]
627 splitPath :: FilePath -> [FilePath]
628 splitPath x = [drive | drive /= ""] ++ f path
629 where
630 (drive,path) = splitDrive x
631
632 f "" = []
633 f y = (a++c) : f d
634 where
635 (a,b) = break isPathSeparator y
636 (c,d) = span isPathSeparator b
637
638 -- | Just as 'splitPath', but don't add the trailing slashes to each element.
639 --
640 -- > splitDirectories "test/file" == ["test","file"]
641 -- > splitDirectories "/test/file" == ["/","test","file"]
642 -- > Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]
643 -- > Posix: Valid x => joinPath (splitDirectories x) `equalFilePath` x
644 -- > splitDirectories "" == []
645 splitDirectories :: FilePath -> [FilePath]
646 splitDirectories path =
647 if hasDrive path then head pathComponents : f (tail pathComponents)
648 else f pathComponents
649 where
650 pathComponents = splitPath path
651
652 f = map g
653 g x = if null res then x else res
654 where res = takeWhile (not . isPathSeparator) x
655
656
657 -- | Join path elements back together.
658 --
659 -- > Valid x => joinPath (splitPath x) == x
660 -- > joinPath [] == ""
661 -- > Posix: joinPath ["test","file","path"] == "test/file/path"
662
663 -- Note that this definition on c:\\c:\\, join then split will give c:\\.
664 joinPath :: [FilePath] -> FilePath
665 joinPath = foldr combine ""
666
667
668
669
670
671
672 ---------------------------------------------------------------------
673 -- File name manipulators
674
675 -- | Equality of two 'FilePath's.
676 -- If you call @System.Directory.canonicalizePath@
677 -- first this has a much better chance of working.
678 -- Note that this doesn't follow symlinks or DOSNAM~1s.
679 --
680 -- > x == y ==> equalFilePath x y
681 -- > normalise x == normalise y ==> equalFilePath x y
682 -- > equalFilePath "foo" "foo/"
683 -- > not (equalFilePath "foo" "/foo")
684 -- > Posix: not (equalFilePath "foo" "FOO")
685 -- > Windows: equalFilePath "foo" "FOO"
686 equalFilePath :: FilePath -> FilePath -> Bool
687 equalFilePath a b = f a == f b
688 where
689 f x | isWindows = dropTrailSlash $ map toLower $ normalise x
690 | otherwise = dropTrailSlash $ normalise x
691
692 dropTrailSlash x | length x >= 2 && hasTrailingPathSeparator x = init x
693 | otherwise = x
694
695
696 -- | Contract a filename, based on a relative path.
697 --
698 -- There is no corresponding @makeAbsolute@ function, instead use
699 -- @System.Directory.canonicalizePath@ which has the same effect.
700 --
701 -- > makeRelative x x == "."
702 -- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"
703 -- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob"
704 -- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"
705 -- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"
706 -- > Windows: makeRelative "/Home" "/home/bob" == "bob"
707 -- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob"
708 -- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
709 -- > Posix: makeRelative "/fred" "bob" == "bob"
710 -- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred"
711 -- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/"
712 -- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
713 makeRelative :: FilePath -> FilePath -> FilePath
714 makeRelative root path
715 | equalFilePath root path = "."
716 | takeAbs root /= takeAbs path = path
717 | otherwise = f (dropAbs root) (dropAbs path)
718 where
719 f "" y = dropWhile isPathSeparator y
720 f x y = let (x1,x2) = g x
721 (y1,y2) = g y
722 in if equalFilePath x1 y1 then f x2 y2 else path
723
724 g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)
725 where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
726
727 -- on windows, need to drop '/' which is kind of absolute, but not a drive
728 dropAbs (x:xs) | isPathSeparator x = xs
729 dropAbs x = dropDrive x
730
731 takeAbs (x:_) | isPathSeparator x = [pathSeparator]
732 takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
733
734 -- | Normalise a file
735 --
736 -- * \/\/ outside of the drive can be made blank
737 --
738 -- * \/ -> 'pathSeparator'
739 --
740 -- * .\/ -> \"\"
741 --
742 -- > Posix: normalise "/file/\\test////" == "/file/\\test/"
743 -- > Posix: normalise "/file/./test" == "/file/test"
744 -- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"
745 -- > Posix: normalise "../bob/fred/" == "../bob/fred/"
746 -- > Posix: normalise "./bob/fred/" == "bob/fred/"
747 -- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
748 -- > Windows: normalise "c:\\" == "C:\\"
749 -- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"
750 -- > Windows: normalise "c:/file" == "C:\\file"
751 -- > normalise "." == "."
752 -- > Posix: normalise "./" == "./"
753 -- > Posix: normalise "./." == "./"
754 -- > Posix: normalise "/" == "/"
755 -- > Posix: normalise "bob/fred/." == "bob/fred/"
756 normalise :: FilePath -> FilePath
757 normalise path = joinDrive' (normaliseDrive drv) (f pth)
758 ++ [pathSeparator | isDirPath pth]
759 where
760 (drv,pth) = splitDrive path
761
762 joinDrive' "" "" = "."
763 joinDrive' d p = joinDrive d p
764
765 isDirPath xs = hasTrailingPathSeparator xs
766 || not (null xs) && last xs == '.' && hasTrailingPathSeparator (init xs)
767
768 f = joinPath . dropDots . splitDirectories . propSep
769
770 propSep (a:b:xs)
771 | isPathSeparator a && isPathSeparator b = propSep (a:xs)
772 propSep (a:xs)
773 | isPathSeparator a = pathSeparator : propSep xs
774 propSep (x:xs) = x : propSep xs
775 propSep [] = []
776
777 dropDots = filter ("." /=)
778
779 normaliseDrive :: FilePath -> FilePath
780 normaliseDrive drive | isPosix = drive
781 normaliseDrive drive = if isJust $ readDriveLetter x2
782 then map toUpper x2
783 else drive
784 where
785 x2 = map repSlash drive
786
787 repSlash x = if isPathSeparator x then pathSeparator else x
788
789 -- Information for validity functions on Windows. See [1].
790 badCharacters :: [Char]
791 badCharacters = ":*?><|\""
792 badElements :: [FilePath]
793 badElements = ["CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9", "CLOCK$"]
794
795
796 -- | Is a FilePath valid, i.e. could you create a file like it?
797 --
798 -- > isValid "" == False
799 -- > Posix: isValid "/random_ path:*" == True
800 -- > Posix: isValid x == not (null x)
801 -- > Windows: isValid "c:\\test" == True
802 -- > Windows: isValid "c:\\test:of_test" == False
803 -- > Windows: isValid "test*" == False
804 -- > Windows: isValid "c:\\test\\nul" == False
805 -- > Windows: isValid "c:\\test\\prn.txt" == False
806 -- > Windows: isValid "c:\\nul\\file" == False
807 -- > Windows: isValid "\\\\" == False
808 isValid :: FilePath -> Bool
809 isValid "" = False
810 isValid _ | isPosix = True
811 isValid path =
812 not (any (`elem` badCharacters) x2) &&
813 not (any f $ splitDirectories x2) &&
814 not (length path >= 2 && all isPathSeparator path)
815 where
816 x2 = dropDrive path
817 f x = map toUpper (dropExtensions x) `elem` badElements
818
819
820 -- | Take a FilePath and make it valid; does not change already valid FilePaths.
821 --
822 -- > isValid (makeValid x)
823 -- > isValid x ==> makeValid x == x
824 -- > makeValid "" == "_"
825 -- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid"
826 -- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"
827 -- > Windows: makeValid "test*" == "test_"
828 -- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"
829 -- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"
830 -- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
831 -- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
832 makeValid :: FilePath -> FilePath
833 makeValid "" = "_"
834 makeValid path | isPosix = path
835 makeValid x | length x >= 2 && all isPathSeparator x = take 2 x ++ "drive"
836 makeValid path = joinDrive drv $ validElements $ validChars pth
837 where
838 (drv,pth) = splitDrive path
839
840 validChars = map f
841 f x | x `elem` badCharacters = '_'
842 | otherwise = x
843
844 validElements x = joinPath $ map g $ splitPath x
845 g x = h a ++ b
846 where (a,b) = break isPathSeparator x
847 h x = if map toUpper a `elem` badElements then a ++ "_" <.> b else x
848 where (a,b) = splitExtensions x
849
850
851 -- | Is a path relative, or is it fixed to the root?
852 --
853 -- > Windows: isRelative "path\\test" == True
854 -- > Windows: isRelative "c:\\test" == False
855 -- > Windows: isRelative "c:test" == True
856 -- > Windows: isRelative "c:\\" == False
857 -- > Windows: isRelative "c:/" == False
858 -- > Windows: isRelative "c:" == True
859 -- > Windows: isRelative "\\\\foo" == False
860 -- > Windows: isRelative "\\\\?\\foo" == False
861 -- > Windows: isRelative "\\\\?\\UNC\\foo" == False
862 -- > Windows: isRelative "/foo" == True
863 -- > Windows: isRelative "\\foo" == True
864 -- > Posix: isRelative "test/path" == True
865 -- > Posix: isRelative "/test" == False
866 -- > Posix: isRelative "/" == False
867 --
868 -- According to [1]:
869 --
870 -- * "A UNC name of any format [is never relative]."
871 --
872 -- * "You cannot use the "\\?\" prefix with a relative path."
873 isRelative :: FilePath -> Bool
874 isRelative = isRelativeDrive . takeDrive
875
876
877 {- c:foo -}
878 -- From [1]: "If a file name begins with only a disk designator but not the
879 -- backslash after the colon, it is interpreted as a relative path to the
880 -- current directory on the drive with the specified letter."
881 isRelativeDrive :: String -> Bool
882 isRelativeDrive x = null x ||
883 maybe False (not . hasTrailingPathSeparator . fst) (readDriveLetter x)
884
885
886 -- | @not . 'isRelative'@
887 --
888 -- > isAbsolute x == not (isRelative x)
889 isAbsolute :: FilePath -> Bool
890 isAbsolute = not . isRelative