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