diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs index 8ef468b853f873be49440a42e214af4d985e851f..64534e8c1848a14ca3205799a66db7b3de0dc450 100644 --- a/System/FilePath/Internal.hs +++ b/System/FilePath/Internal.hs @@ -668,15 +668,12 @@ 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) @@ -684,7 +681,7 @@ splitFileName_ fp -- 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.