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