Add/expose hasLeadingPathSeparator, addLeadingPathSeparator, dropLead…

…ingPathSeparator
haskell · Dec 3, 2021 · 0b87163 · 0b87163
1 parent 3dbdea8
commit 0b87163
Show file tree

Hide file tree

Showing 5 changed files with 125 additions and 0 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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)