Skip to content

Commit 0b87163

Browse files
hasufellhasufell
committed
Add/expose hasLeadingPathSeparator, addLeadingPathSeparator, dropLeadingPathSeparator
1 parent 3dbdea8 commit 0b87163

File tree

5 files changed

+125
-0
lines changed

5 files changed

+125
-0
lines changed

‎System/FilePath.hs

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -91,6 +91,11 @@ module System.FilePath(
9191
splitDrive, joinDrive,
9292
takeDrive, hasDrive, dropDrive, isDrive,
9393

94+
-- * Leading slash functions
95+
hasLeadingPathSeparator,
96+
addLeadingPathSeparator,
97+
dropLeadingPathSeparator,
98+
9499
-- * Trailing slash functions
95100
hasTrailingPathSeparator,
96101
addTrailingPathSeparator,
@@ -132,6 +137,11 @@ module System.FilePath(
132137
splitDrive, joinDrive,
133138
takeDrive, hasDrive, dropDrive, isDrive,
134139

140+
-- * Leading slash functions
141+
hasLeadingPathSeparator,
142+
addLeadingPathSeparator,
143+
dropLeadingPathSeparator,
144+
135145
-- * Trailing slash functions
136146
hasTrailingPathSeparator,
137147
addTrailingPathSeparator,

‎System/FilePath/Internal.hs

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,11 @@ module System.FilePath.MODULE_NAME
9090
splitDrive, joinDrive,
9191
takeDrive, hasDrive, dropDrive, isDrive,
9292

93+
-- * Leading slash functions
94+
hasLeadingPathSeparator,
95+
addLeadingPathSeparator,
96+
dropLeadingPathSeparator,
97+
9398
-- * Trailing slash functions
9499
hasTrailingPathSeparator,
95100
addTrailingPathSeparator,
@@ -599,10 +604,38 @@ hasTrailingPathSeparator "" = False
599604
hasTrailingPathSeparator x = isPathSeparator (last x)
600605

601606

607+
-- | Does the item have a leading path separator?
608+
--
609+
-- On unix, this is equivalent to 'isAbsolute', on Windows it isn't.
610+
--
611+
-- > Posix: hasLeadingPathSeparator x == isAbsolute x
612+
-- > hasLeadingPathSeparator "test" == False
613+
-- > hasLeadingPathSeparator "/test" == True
602614
hasLeadingPathSeparator :: FilePath -> Bool
603615
hasLeadingPathSeparator "" = False
604616
hasLeadingPathSeparator x = isPathSeparator (head x)
605617

618+
-- | Add a leading file path separator if one is not already present.
619+
--
620+
-- > hasLeadingPathSeparator (addLeadingPathSeparator x)
621+
-- > hasLeadingPathSeparator x ==> addLeadingPathSeparator x == x
622+
-- > Posix: addLeadingPathSeparator "test/rest" == "/test/rest"
623+
addLeadingPathSeparator :: FilePath -> FilePath
624+
addLeadingPathSeparator x = if hasLeadingPathSeparator x then x else pathSeparator:x
625+
626+
-- | Remove any leading path separators
627+
--
628+
-- > dropLeadingPathSeparator "//file/test/" == "file/test/"
629+
-- > dropLeadingPathSeparator "/" == "/"
630+
-- > Windows: dropLeadingPathSeparator "\\" == "\\"
631+
-- > Posix: not (hasLeadingPathSeparator (dropLeadingPathSeparator x)) || isDrive x
632+
dropLeadingPathSeparator :: FilePath -> FilePath
633+
dropLeadingPathSeparator x =
634+
if hasLeadingPathSeparator x && not (isDrive x)
635+
then let x' = dropWhile isPathSeparator x
636+
in if null x' then [last x] else x'
637+
else x
638+
606639

607640
-- | Add a trailing file path separator if one is not already present.
608641
--

‎System/FilePath/Posix.hs

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,11 @@ module System.FilePath.Posix
9090
splitDrive, joinDrive,
9191
takeDrive, hasDrive, dropDrive, isDrive,
9292

93+
-- * Leading slash functions
94+
hasLeadingPathSeparator,
95+
addLeadingPathSeparator,
96+
dropLeadingPathSeparator,
97+
9398
-- * Trailing slash functions
9499
hasTrailingPathSeparator,
95100
addTrailingPathSeparator,
@@ -599,10 +604,38 @@ hasTrailingPathSeparator "" = False
599604
hasTrailingPathSeparator x = isPathSeparator (last x)
600605

601606

607+
-- | Does the item have a leading path separator?
608+
--
609+
-- On unix, this is equivalent to 'isAbsolute', on Windows it isn't.
610+
--
611+
-- > Posix: hasLeadingPathSeparator x == isAbsolute x
612+
-- > hasLeadingPathSeparator "test" == False
613+
-- > hasLeadingPathSeparator "/test" == True
602614
hasLeadingPathSeparator :: FilePath -> Bool
603615
hasLeadingPathSeparator "" = False
604616
hasLeadingPathSeparator x = isPathSeparator (head x)
605617

618+
-- | Add a leading file path separator if one is not already present.
619+
--
620+
-- > hasLeadingPathSeparator (addLeadingPathSeparator x)
621+
-- > hasLeadingPathSeparator x ==> addLeadingPathSeparator x == x
622+
-- > Posix: addLeadingPathSeparator "test/rest" == "/test/rest"
623+
addLeadingPathSeparator :: FilePath -> FilePath
624+
addLeadingPathSeparator x = if hasLeadingPathSeparator x then x else pathSeparator:x
625+
626+
-- | Remove any leading path separators
627+
--
628+
-- > dropLeadingPathSeparator "//file/test/" == "file/test/"
629+
-- > dropLeadingPathSeparator "/" == "/"
630+
-- > Windows: dropLeadingPathSeparator "\\" == "\\"
631+
-- > Posix: not (hasLeadingPathSeparator (dropLeadingPathSeparator x)) || isDrive x
632+
dropLeadingPathSeparator :: FilePath -> FilePath
633+
dropLeadingPathSeparator x =
634+
if hasLeadingPathSeparator x && not (isDrive x)
635+
then let x' = dropWhile isPathSeparator x
636+
in if null x' then [last x] else x'
637+
else x
638+
606639

607640
-- | Add a trailing file path separator if one is not already present.
608641
--

‎System/FilePath/Windows.hs

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,11 @@ module System.FilePath.Windows
9090
splitDrive, joinDrive,
9191
takeDrive, hasDrive, dropDrive, isDrive,
9292

93+
-- * Leading slash functions
94+
hasLeadingPathSeparator,
95+
addLeadingPathSeparator,
96+
dropLeadingPathSeparator,
97+
9398
-- * Trailing slash functions
9499
hasTrailingPathSeparator,
95100
addTrailingPathSeparator,
@@ -599,10 +604,38 @@ hasTrailingPathSeparator "" = False
599604
hasTrailingPathSeparator x = isPathSeparator (last x)
600605

601606

607+
-- | Does the item have a leading path separator?
608+
--
609+
-- On unix, this is equivalent to 'isAbsolute', on Windows it isn't.
610+
--
611+
-- > Posix: hasLeadingPathSeparator x == isAbsolute x
612+
-- > hasLeadingPathSeparator "test" == False
613+
-- > hasLeadingPathSeparator "/test" == True
602614
hasLeadingPathSeparator :: FilePath -> Bool
603615
hasLeadingPathSeparator "" = False
604616
hasLeadingPathSeparator x = isPathSeparator (head x)
605617

618+
-- | Add a leading file path separator if one is not already present.
619+
--
620+
-- > hasLeadingPathSeparator (addLeadingPathSeparator x)
621+
-- > hasLeadingPathSeparator x ==> addLeadingPathSeparator x == x
622+
-- > Posix: addLeadingPathSeparator "test/rest" == "/test/rest"
623+
addLeadingPathSeparator :: FilePath -> FilePath
624+
addLeadingPathSeparator x = if hasLeadingPathSeparator x then x else pathSeparator:x
625+
626+
-- | Remove any leading path separators
627+
--
628+
-- > dropLeadingPathSeparator "//file/test/" == "file/test/"
629+
-- > dropLeadingPathSeparator "/" == "/"
630+
-- > Windows: dropLeadingPathSeparator "\\" == "\\"
631+
-- > Posix: not (hasLeadingPathSeparator (dropLeadingPathSeparator x)) || isDrive x
632+
dropLeadingPathSeparator :: FilePath -> FilePath
633+
dropLeadingPathSeparator x =
634+
if hasLeadingPathSeparator x && not (isDrive x)
635+
then let x' = dropWhile isPathSeparator x
636+
in if null x' then [last x] else x'
637+
else x
638+
606639

607640
-- | Add a trailing file path separator if one is not already present.
608641
--

‎tests/TestGen.hs

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -268,6 +268,22 @@ tests =
268268
,("W.hasTrailingPathSeparator \"test\" == False", property $ W.hasTrailingPathSeparator "test" == False)
269269
,("P.hasTrailingPathSeparator \"test/\" == True", property $ P.hasTrailingPathSeparator "test/" == True)
270270
,("W.hasTrailingPathSeparator \"test/\" == True", property $ W.hasTrailingPathSeparator "test/" == True)
271+
,("P.hasLeadingPathSeparator x == P.isAbsolute x", property $ \(QFilePath x) -> P.hasLeadingPathSeparator x == P.isAbsolute x)
272+
,("P.hasLeadingPathSeparator \"test\" == False", property $ P.hasLeadingPathSeparator "test" == False)
273+
,("W.hasLeadingPathSeparator \"test\" == False", property $ W.hasLeadingPathSeparator "test" == False)
274+
,("P.hasLeadingPathSeparator \"/test\" == True", property $ P.hasLeadingPathSeparator "/test" == True)
275+
,("W.hasLeadingPathSeparator \"/test\" == True", property $ W.hasLeadingPathSeparator "/test" == True)
276+
,("P.hasLeadingPathSeparator (P.addLeadingPathSeparator x)", property $ \(QFilePath x) -> P.hasLeadingPathSeparator (P.addLeadingPathSeparator x))
277+
,("W.hasLeadingPathSeparator (W.addLeadingPathSeparator x)", property $ \(QFilePath x) -> W.hasLeadingPathSeparator (W.addLeadingPathSeparator x))
278+
,("P.hasLeadingPathSeparator x ==> P.addLeadingPathSeparator x == x", property $ \(QFilePath x) -> P.hasLeadingPathSeparator x ==> P.addLeadingPathSeparator x == x)
279+
,("W.hasLeadingPathSeparator x ==> W.addLeadingPathSeparator x == x", property $ \(QFilePath x) -> W.hasLeadingPathSeparator x ==> W.addLeadingPathSeparator x == x)
280+
,("P.addLeadingPathSeparator \"test/rest\" == \"/test/rest\"", property $ P.addLeadingPathSeparator "test/rest" == "/test/rest")
281+
,("P.dropLeadingPathSeparator \"//file/test/\" == \"file/test/\"", property $ P.dropLeadingPathSeparator "//file/test/" == "file/test/")
282+
,("W.dropLeadingPathSeparator \"//file/test/\" == \"file/test/\"", property $ W.dropLeadingPathSeparator "//file/test/" == "file/test/")
283+
,("P.dropLeadingPathSeparator \"/\" == \"/\"", property $ P.dropLeadingPathSeparator "/" == "/")
284+
,("W.dropLeadingPathSeparator \"/\" == \"/\"", property $ W.dropLeadingPathSeparator "/" == "/")
285+
,("W.dropLeadingPathSeparator \"\\\\\" == \"\\\\\"", property $ W.dropLeadingPathSeparator "\\" == "\\")
286+
,("not (P.hasLeadingPathSeparator (P.dropLeadingPathSeparator x)) || P.isDrive x", property $ \(QFilePath x) -> not (P.hasLeadingPathSeparator (P.dropLeadingPathSeparator x)) || P.isDrive x)
271287
,("P.hasTrailingPathSeparator (P.addTrailingPathSeparator x)", property $ \(QFilePath x) -> P.hasTrailingPathSeparator (P.addTrailingPathSeparator x))
272288
,("W.hasTrailingPathSeparator (W.addTrailingPathSeparator x)", property $ \(QFilePath x) -> W.hasTrailingPathSeparator (W.addTrailingPathSeparator x))
273289
,("P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x", property $ \(QFilePath x) -> P.hasTrailingPathSeparator x ==> P.addTrailingPathSeparator x == x)

0 commit comments

Comments
 (0)