Skip to content

Commit

Permalink
Improve/rename dropExcessTrailingPathSeparators
Browse files Browse the repository at this point in the history
  • Loading branch information
hasufell committed Jan 25, 2024
1 parent 74713b9 commit 071b671
Showing 1 changed file with 7 additions and 10 deletions.
17 changes: 7 additions & 10 deletions System/FilePath/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -668,23 +668,20 @@ splitFileName_ fp
= (dirSlash, file)
where
(dirSlash, file) = breakEnd isPathSeparator fp
-- an adjustant variant of 'dropTrailingPathSeparator' that normalises trailing path separators
-- on windows
dropTrailingPathSeparator' x =
if hasTrailingPathSeparator x
then let x' = dropWhileEnd isPathSeparator x
in if | null x' -> singleton (last x)
| isDrive x -> addTrailingPathSeparator x'
| otherwise -> x'
else x
dropExcessTrailingPathSeparators x
| hasTrailingPathSeparator x
, let x' = dropWhileEnd isPathSeparator x
, otherwise = if | null x' -> singleton (last x)
| otherwise -> addTrailingPathSeparator x'
| otherwise = x

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

-- e.g. @//?/a:/@ or @//?/a://@, but not @//?/a:@
hasPenultimateColon pref
| hasTrailingPathSeparator pref
= maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropTrailingPathSeparator' $ pref
= maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropExcessTrailingPathSeparators $ pref
| otherwise = False

-- | Set the filename.
Expand Down

0 comments on commit 071b671

Please sign in to comment.