diff --git a/Generate.hs b/Generate.hs index 6937b2ae..67523c5c 100755 --- a/Generate.hs +++ b/Generate.hs @@ -87,7 +87,7 @@ qualify pw str where prelude = ["elem","uncurry","snd","fst","not","null","if","then","else" ,"True","False","Just","Nothing","fromJust","concat","isPrefixOf","isSuffixOf","any","foldr"] - fpops = ["","<.>","-<.>"] + fpops = ["<\\>", "","<.>","-<.>"] --------------------------------------------------------------------- diff --git a/System/FilePath.hs b/System/FilePath.hs index b760a319..430f0d36 100644 --- a/System/FilePath.hs +++ b/System/FilePath.hs @@ -85,12 +85,18 @@ module System.FilePath( takeBaseName, replaceBaseName, takeDirectory, replaceDirectory, combine, (), + combineAlways, (<\>), splitPath, joinPath, splitDirectories, -- * Drive functions splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, @@ -126,12 +132,18 @@ module System.FilePath( takeBaseName, replaceBaseName, takeDirectory, replaceDirectory, combine, (), + combineAlways, (<\>), splitPath, joinPath, splitDirectories, -- * Drive functions splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs index bce55063..c59c23d1 100644 --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -84,12 +84,18 @@ module System.FilePath.MODULE_NAME takeBaseName, replaceBaseName, takeDirectory, replaceDirectory, combine, (), + combineAlways, (<\>), splitPath, joinPath, splitDirectories, -- * Drive functions splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, @@ -112,6 +118,7 @@ import System.Environment(getEnv) infixr 7 <.>, -<.> infixr 5 +infixr 5 <\> @@ -599,10 +606,38 @@ hasTrailingPathSeparator "" = False hasTrailingPathSeparator x = isPathSeparator (last x) +-- | Does the item have a leading path separator? +-- +-- On unix, this is equivalent to 'isAbsolute', on Windows it isn't. +-- +-- > Posix: hasLeadingPathSeparator x == isAbsolute x +-- > hasLeadingPathSeparator "test" == False +-- > hasLeadingPathSeparator "/test" == True hasLeadingPathSeparator :: FilePath -> Bool hasLeadingPathSeparator "" = False hasLeadingPathSeparator x = isPathSeparator (head x) +-- | Add a leading file path separator if one is not already present. +-- +-- > hasLeadingPathSeparator (addLeadingPathSeparator x) +-- > hasLeadingPathSeparator x ==> addLeadingPathSeparator x == x +-- > Posix: addLeadingPathSeparator "test/rest" == "/test/rest" +addLeadingPathSeparator :: FilePath -> FilePath +addLeadingPathSeparator x = if hasLeadingPathSeparator x then x else pathSeparator:x + +-- | Remove any leading path separators +-- +-- > dropLeadingPathSeparator "//file/test/" == "file/test/" +-- > dropLeadingPathSeparator "/" == "/" +-- > Windows: dropLeadingPathSeparator "\\" == "\\" +-- > Posix: not (hasLeadingPathSeparator (dropLeadingPathSeparator x)) || isDrive x +dropLeadingPathSeparator :: FilePath -> FilePath +dropLeadingPathSeparator x = + if hasLeadingPathSeparator x && not (isDrive x) + then let x' = dropWhile isPathSeparator x + in if null x' then [last x] else x' + else x + -- | Add a trailing file path separator if one is not already present. -- @@ -711,6 +746,24 @@ combineAlways a b | null a = b () = combine +-- | Combine two paths, assuming rhs is NOT absolute. +-- +-- > Posix: "/directory" <\> "file.ext" == "/directory/file.ext" +-- > Windows: "/directory" <\> "file.ext" == "/directory\\file.ext" +-- > Valid x => (takeDirectory x <\> takeFileName x) `equalFilePath` x +-- > Posix: "/" <\> "test" == "/test" +-- > Posix: "home" <\> "bob" == "home/bob" +-- > Posix: "x:" <\> "foo" == "x:/foo" +-- > Windows: "C:\\foo" <\> "bar" == "C:\\foo\\bar" +-- > Windows: "home" <\> "bob" == "home\\bob" +-- > Posix: "home" <\> "/bob" == "home//bob" +-- > Windows: "home" <\> "C:\\bob" == "home\\C:\\bob" +-- > Windows: "D:\\foo" <\> "C:bar" == "D:\\foo\\C:bar" +-- > Windows: "C:\\foo" <\> "C:bar" == "C:\\foo\\C:bar" +(<\>) :: FilePath -> FilePath -> FilePath +(<\>) = combineAlways + + -- | Split a path by the directory separator. -- -- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] diff --git a/System/FilePath/Posix.hs b/System/FilePath/Posix.hs index becb0d11..54e0d01f 100644 --- a/System/FilePath/Posix.hs +++ b/System/FilePath/Posix.hs @@ -84,12 +84,18 @@ module System.FilePath.Posix takeBaseName, replaceBaseName, takeDirectory, replaceDirectory, combine, (), + combineAlways, (<\>), splitPath, joinPath, splitDirectories, -- * Drive functions splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, @@ -112,6 +118,7 @@ import System.Environment(getEnv) infixr 7 <.>, -<.> infixr 5 +infixr 5 <\> @@ -599,10 +606,38 @@ hasTrailingPathSeparator "" = False hasTrailingPathSeparator x = isPathSeparator (last x) +-- | Does the item have a leading path separator? +-- +-- On unix, this is equivalent to 'isAbsolute', on Windows it isn't. +-- +-- > Posix: hasLeadingPathSeparator x == isAbsolute x +-- > hasLeadingPathSeparator "test" == False +-- > hasLeadingPathSeparator "/test" == True hasLeadingPathSeparator :: FilePath -> Bool hasLeadingPathSeparator "" = False hasLeadingPathSeparator x = isPathSeparator (head x) +-- | Add a leading file path separator if one is not already present. +-- +-- > hasLeadingPathSeparator (addLeadingPathSeparator x) +-- > hasLeadingPathSeparator x ==> addLeadingPathSeparator x == x +-- > Posix: addLeadingPathSeparator "test/rest" == "/test/rest" +addLeadingPathSeparator :: FilePath -> FilePath +addLeadingPathSeparator x = if hasLeadingPathSeparator x then x else pathSeparator:x + +-- | Remove any leading path separators +-- +-- > dropLeadingPathSeparator "//file/test/" == "file/test/" +-- > dropLeadingPathSeparator "/" == "/" +-- > Windows: dropLeadingPathSeparator "\\" == "\\" +-- > Posix: not (hasLeadingPathSeparator (dropLeadingPathSeparator x)) || isDrive x +dropLeadingPathSeparator :: FilePath -> FilePath +dropLeadingPathSeparator x = + if hasLeadingPathSeparator x && not (isDrive x) + then let x' = dropWhile isPathSeparator x + in if null x' then [last x] else x' + else x + -- | Add a trailing file path separator if one is not already present. -- @@ -711,6 +746,24 @@ combineAlways a b | null a = b () = combine +-- | Combine two paths, assuming rhs is NOT absolute. +-- +-- > Posix: "/directory" <\> "file.ext" == "/directory/file.ext" +-- > Windows: "/directory" <\> "file.ext" == "/directory\\file.ext" +-- > Valid x => (takeDirectory x <\> takeFileName x) `equalFilePath` x +-- > Posix: "/" <\> "test" == "/test" +-- > Posix: "home" <\> "bob" == "home/bob" +-- > Posix: "x:" <\> "foo" == "x:/foo" +-- > Windows: "C:\\foo" <\> "bar" == "C:\\foo\\bar" +-- > Windows: "home" <\> "bob" == "home\\bob" +-- > Posix: "home" <\> "/bob" == "home//bob" +-- > Windows: "home" <\> "C:\\bob" == "home\\C:\\bob" +-- > Windows: "D:\\foo" <\> "C:bar" == "D:\\foo\\C:bar" +-- > Windows: "C:\\foo" <\> "C:bar" == "C:\\foo\\C:bar" +(<\>) :: FilePath -> FilePath -> FilePath +(<\>) = combineAlways + + -- | Split a path by the directory separator. -- -- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] diff --git a/System/FilePath/Windows.hs b/System/FilePath/Windows.hs index c085c8e5..1aad2e17 100644 --- a/System/FilePath/Windows.hs +++ b/System/FilePath/Windows.hs @@ -84,12 +84,18 @@ module System.FilePath.Windows takeBaseName, replaceBaseName, takeDirectory, replaceDirectory, combine, (), + combineAlways, (<\>), splitPath, joinPath, splitDirectories, -- * Drive functions splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, @@ -112,6 +118,7 @@ import System.Environment(getEnv) infixr 7 <.>, -<.> infixr 5 +infixr 5 <\> @@ -599,10 +606,38 @@ hasTrailingPathSeparator "" = False hasTrailingPathSeparator x = isPathSeparator (last x) +-- | Does the item have a leading path separator? +-- +-- On unix, this is equivalent to 'isAbsolute', on Windows it isn't. +-- +-- > Posix: hasLeadingPathSeparator x == isAbsolute x +-- > hasLeadingPathSeparator "test" == False +-- > hasLeadingPathSeparator "/test" == True hasLeadingPathSeparator :: FilePath -> Bool hasLeadingPathSeparator "" = False hasLeadingPathSeparator x = isPathSeparator (head x) +-- | Add a leading file path separator if one is not already present. +-- +-- > hasLeadingPathSeparator (addLeadingPathSeparator x) +-- > hasLeadingPathSeparator x ==> addLeadingPathSeparator x == x +-- > Posix: addLeadingPathSeparator "test/rest" == "/test/rest" +addLeadingPathSeparator :: FilePath -> FilePath +addLeadingPathSeparator x = if hasLeadingPathSeparator x then x else pathSeparator:x + +-- | Remove any leading path separators +-- +-- > dropLeadingPathSeparator "//file/test/" == "file/test/" +-- > dropLeadingPathSeparator "/" == "/" +-- > Windows: dropLeadingPathSeparator "\\" == "\\" +-- > Posix: not (hasLeadingPathSeparator (dropLeadingPathSeparator x)) || isDrive x +dropLeadingPathSeparator :: FilePath -> FilePath +dropLeadingPathSeparator x = + if hasLeadingPathSeparator x && not (isDrive x) + then let x' = dropWhile isPathSeparator x + in if null x' then [last x] else x' + else x + -- | Add a trailing file path separator if one is not already present. -- @@ -711,6 +746,24 @@ combineAlways a b | null a = b () = combine +-- | Combine two paths, assuming rhs is NOT absolute. +-- +-- > Posix: "/directory" <\> "file.ext" == "/directory/file.ext" +-- > Windows: "/directory" <\> "file.ext" == "/directory\\file.ext" +-- > Valid x => (takeDirectory x <\> takeFileName x) `equalFilePath` x +-- > Posix: "/" <\> "test" == "/test" +-- > Posix: "home" <\> "bob" == "home/bob" +-- > Posix: "x:" <\> "foo" == "x:/foo" +-- > Windows: "C:\\foo" <\> "bar" == "C:\\foo\\bar" +-- > Windows: "home" <\> "bob" == "home\\bob" +-- > Posix: "home" <\> "/bob" == "home//bob" +-- > Windows: "home" <\> "C:\\bob" == "home\\C:\\bob" +-- > Windows: "D:\\foo" <\> "C:bar" == "D:\\foo\\C:bar" +-- > Windows: "C:\\foo" <\> "C:bar" == "C:\\foo\\C:bar" +(<\>) :: FilePath -> FilePath -> FilePath +(<\>) = combineAlways + + -- | Split a path by the directory separator. -- -- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"] diff --git a/tests/TestGen.hs b/tests/TestGen.hs index e00dd71e..a001235a 100755 --- a/tests/TestGen.hs +++ b/tests/TestGen.hs @@ -268,6 +268,22 @@ tests = ,("W.hasTrailingPathSeparator \"test\" == False", property $ W.hasTrailingPathSeparator "test" == False) ,("P.hasTrailingPathSeparator \"test/\" == True", property $ P.hasTrailingPathSeparator "test/" == True) ,("W.hasTrailingPathSeparator \"test/\" == True", property $ W.hasTrailingPathSeparator "test/" == True) + ,("P.hasLeadingPathSeparator x == P.isAbsolute x", property $ \(QFilePath x) -> P.hasLeadingPathSeparator x == P.isAbsolute x) + ,("P.hasLeadingPathSeparator \"test\" == False", property $ P.hasLeadingPathSeparator "test" == False) + ,("W.hasLeadingPathSeparator \"test\" == False", property $ W.hasLeadingPathSeparator "test" == False) + ,("P.hasLeadingPathSeparator \"/test\" == True", property $ P.hasLeadingPathSeparator "/test" == True) + ,("W.hasLeadingPathSeparator \"/test\" == True", property $ W.hasLeadingPathSeparator "/test" == True) + ,("P.hasLeadingPathSeparator (P.addLeadingPathSeparator x)", property $ \(QFilePath x) -> P.hasLeadingPathSeparator (P.addLeadingPathSeparator x)) + ,("W.hasLeadingPathSeparator (W.addLeadingPathSeparator x)", property $ \(QFilePath x) -> W.hasLeadingPathSeparator (W.addLeadingPathSeparator x)) + ,("P.hasLeadingPathSeparator x ==> P.addLeadingPathSeparator x == x", property $ \(QFilePath x) -> P.hasLeadingPathSeparator x ==> P.addLeadingPathSeparator x == x) + ,("W.hasLeadingPathSeparator x ==> W.addLeadingPathSeparator x == x", property $ \(QFilePath x) -> W.hasLeadingPathSeparator x ==> W.addLeadingPathSeparator x == x) + ,("P.addLeadingPathSeparator \"test/rest\" == \"/test/rest\"", property $ P.addLeadingPathSeparator "test/rest" == "/test/rest") + ,("P.dropLeadingPathSeparator \"//file/test/\" == \"file/test/\"", property $ P.dropLeadingPathSeparator "//file/test/" == "file/test/") + ,("W.dropLeadingPathSeparator \"//file/test/\" == \"file/test/\"", property $ W.dropLeadingPathSeparator "//file/test/" == "file/test/") + ,("P.dropLeadingPathSeparator \"/\" == \"/\"", property $ P.dropLeadingPathSeparator "/" == "/") + ,("W.dropLeadingPathSeparator \"/\" == \"/\"", property $ W.dropLeadingPathSeparator "/" == "/") + ,("W.dropLeadingPathSeparator \"\\\\\" == \"\\\\\"", property $ W.dropLeadingPathSeparator "\\" == "\\") + ,("not (P.hasLeadingPathSeparator (P.dropLeadingPathSeparator x)) || P.isDrive x", property $ \(QFilePath x) -> not (P.hasLeadingPathSeparator (P.dropLeadingPathSeparator x)) || P.isDrive x) ,("P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)", property $ \(QFilePath x) -> P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)) ,("W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)", property $ \(QFilePath x) -> W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)) ,("P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x", property $ \(QFilePath x) -> P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x) @@ -320,6 +336,19 @@ tests = ,("\"C:\\\\home\" W. \"\\\\bob\" == \"\\\\bob\"", property $ "C:\\home" W. "\\bob" == "\\bob") ,("\"D:\\\\foo\" W. \"C:bar\" == \"C:bar\"", property $ "D:\\foo" W. "C:bar" == "C:bar") ,("\"C:\\\\foo\" W. \"C:bar\" == \"C:bar\"", property $ "C:\\foo" W. "C:bar" == "C:bar") + ,("\"/directory\" P.<\\> \"file.ext\" == \"/directory/file.ext\"", property $ "/directory" P.<\> "file.ext" == "/directory/file.ext") + ,("\"/directory\" W.<\\> \"file.ext\" == \"/directory\\\\file.ext\"", property $ "/directory" W.<\> "file.ext" == "/directory\\file.ext") + ,("(P.takeDirectory x P.<\\> P.takeFileName x) `P.equalFilePath` x", property $ \(QFilePathValidP x) -> (P.takeDirectory x P.<\> P.takeFileName x) `P.equalFilePath` x) + ,("(W.takeDirectory x W.<\\> W.takeFileName x) `W.equalFilePath` x", property $ \(QFilePathValidW x) -> (W.takeDirectory x W.<\> W.takeFileName x) `W.equalFilePath` x) + ,("\"/\" P.<\\> \"test\" == \"/test\"", property $ "/" P.<\> "test" == "/test") + ,("\"home\" P.<\\> \"bob\" == \"home/bob\"", property $ "home" P.<\> "bob" == "home/bob") + ,("\"x:\" P.<\\> \"foo\" == \"x:/foo\"", property $ "x:" P.<\> "foo" == "x:/foo") + ,("\"C:\\\\foo\" W.<\\> \"bar\" == \"C:\\\\foo\\\\bar\"", property $ "C:\\foo" W.<\> "bar" == "C:\\foo\\bar") + ,("\"home\" W.<\\> \"bob\" == \"home\\\\bob\"", property $ "home" W.<\> "bob" == "home\\bob") + ,("\"home\" P.<\\> \"/bob\" == \"home//bob\"", property $ "home" P.<\> "/bob" == "home//bob") + ,("\"home\" W.<\\> \"C:\\\\bob\" == \"home\\\\C:\\\\bob\"", property $ "home" W.<\> "C:\\bob" == "home\\C:\\bob") + ,("\"D:\\\\foo\" W.<\\> \"C:bar\" == \"D:\\\\foo\\\\C:bar\"", property $ "D:\\foo" W.<\> "C:bar" == "D:\\foo\\C:bar") + ,("\"C:\\\\foo\" W.<\\> \"C:bar\" == \"C:\\\\foo\\\\C:bar\"", property $ "C:\\foo" W.<\> "C:bar" == "C:\\foo\\C:bar") ,("P.splitPath \"/directory/file.ext\" == [\"/\", \"directory/\", \"file.ext\"]", property $ P.splitPath "/directory/file.ext" == ["/", "directory/", "file.ext"]) ,("W.splitPath \"/directory/file.ext\" == [\"/\", \"directory/\", \"file.ext\"]", property $ W.splitPath "/directory/file.ext" == ["/", "directory/", "file.ext"]) ,("concat (P.splitPath x) == x", property $ \(QFilePath x) -> concat (P.splitPath x) == x)