Skip to content

Commit

Permalink
Truly fix splitFileName on windows
Browse files Browse the repository at this point in the history
  • Loading branch information
hasufell committed Jan 25, 2024
1 parent 0530486 commit 74713b9
Showing 1 changed file with 18 additions and 2 deletions.
20 changes: 18 additions & 2 deletions System/FilePath/Internal.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiWayIf #-}

-- This template expects CPP definitions for:
-- MODULE_NAME = Posix | Windows
Expand Down Expand Up @@ -667,9 +668,24 @@ 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

-- an "incomplete" UNC is one without a path (but potentially a drive)
isIncompleteUNC (pref, suff) = null suff && not (hasPenultimateColon pref)
hasPenultimateColon = maybe False (maybe False ((== _colon) . snd) . unsnoc . fst) . unsnoc

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

-- | Set the filename.
--
Expand Down

0 comments on commit 74713b9

Please sign in to comment.