Skip to content

Commit 74713b9

Browse files
committed
Truly fix splitFileName on windows
1 parent 0530486 commit 74713b9

File tree

1 file changed

+18
-2
lines changed

1 file changed

+18
-2
lines changed

System/FilePath/Internal.hs

Lines changed: 18 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE PatternGuards #-}
22
{-# LANGUAGE TypeApplications #-}
3+
{-# LANGUAGE MultiWayIf #-}
34

45
-- This template expects CPP definitions for:
56
-- MODULE_NAME = Posix | Windows
@@ -667,9 +668,24 @@ splitFileName_ fp
667668
= (dirSlash, file)
668669
where
669670
(dirSlash, file) = breakEnd isPathSeparator fp
670-
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
680+
681+
-- an "incomplete" UNC is one without a path (but potentially a drive)
671682
isIncompleteUNC (pref, suff) = null suff && not (hasPenultimateColon pref)
672-
hasPenultimateColon = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc
683+
684+
-- e.g. @//?/a:/@ or @//?/a://@, but not @//?/a:@
685+
hasPenultimateColon pref
686+
| hasTrailingPathSeparator pref
687+
= maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc . dropTrailingPathSeparator' $ pref
688+
| otherwise = False
673689

674690
-- | Set the filename.
675691
--

0 commit comments

Comments
 (0)