Skip to content

Commit 071b671

Browse files
committed
Improve/rename dropExcessTrailingPathSeparators
1 parent 74713b9 commit 071b671

File tree

1 file changed

+7
-10
lines changed

1 file changed

+7
-10
lines changed

System/FilePath/Internal.hs

Lines changed: 7 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -668,23 +668,20 @@ splitFileName_ fp
668668
= (dirSlash, file)
669669
where
670670
(dirSlash, file) = breakEnd isPathSeparator fp
671-
-- an adjustant variant of 'dropTrailingPathSeparator' that normalises trailing path separators
672-
-- on windows
673-
dropTrailingPathSeparator' x =
674-
if hasTrailingPathSeparator x
675-
then let x' = dropWhileEnd isPathSeparator x
676-
in if | null x' -> singleton (last x)
677-
| isDrive x -> addTrailingPathSeparator x'
678-
| otherwise -> x'
679-
else x
671+
dropExcessTrailingPathSeparators x
672+
| hasTrailingPathSeparator x
673+
, let x' = dropWhileEnd isPathSeparator x
674+
, otherwise = if | null x' -> singleton (last x)
675+
| otherwise -> addTrailingPathSeparator x'
676+
| otherwise = x
680677

681678
-- an "incomplete" UNC is one without a path (but potentially a drive)
682679
isIncompleteUNC (pref, suff) = null suff && not (hasPenultimateColon pref)
683680

684681
-- e.g. @//?/a:/@ or @//?/a://@, but not @//?/a:@
685682
hasPenultimateColon pref
686683
| hasTrailingPathSeparator pref
687-
= maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropTrailingPathSeparator' $ pref
684+
= maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropExcessTrailingPathSeparators $ pref
688685
| otherwise = False
689686

690687
-- | Set the filename.

0 commit comments

Comments
 (0)