diff --git a/System/FilePath.hs b/System/FilePath.hs index b760a319..0feea8da 100644 --- a/System/FilePath.hs +++ b/System/FilePath.hs @@ -91,6 +91,11 @@ module System.FilePath( splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, @@ -132,6 +137,11 @@ module System.FilePath( 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..cb3f8511 100644 --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -90,6 +90,11 @@ module System.FilePath.MODULE_NAME splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, @@ -599,10 +604,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. -- diff --git a/System/FilePath/Posix.hs b/System/FilePath/Posix.hs index becb0d11..9afd16bf 100644 --- a/System/FilePath/Posix.hs +++ b/System/FilePath/Posix.hs @@ -90,6 +90,11 @@ module System.FilePath.Posix splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, @@ -599,10 +604,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. -- diff --git a/System/FilePath/Windows.hs b/System/FilePath/Windows.hs index c085c8e5..e232adac 100644 --- a/System/FilePath/Windows.hs +++ b/System/FilePath/Windows.hs @@ -90,6 +90,11 @@ module System.FilePath.Windows splitDrive, joinDrive, takeDrive, hasDrive, dropDrive, isDrive, + -- * Leading slash functions + hasLeadingPathSeparator, + addLeadingPathSeparator, + dropLeadingPathSeparator, + -- * Trailing slash functions hasTrailingPathSeparator, addTrailingPathSeparator, @@ -599,10 +604,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. -- diff --git a/tests/TestGen.hs b/tests/TestGen.hs index e00dd71e..1c92b181 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)