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