Skip to content

Commit

Permalink
Merge pull request haskell#35 from thomie/splitExtensions
Browse files Browse the repository at this point in the history
Refactor and fix test for splitExtension(s)
  • Loading branch information
ndmitchell committed Nov 1, 2014
2 parents 259f9e2 + 881afa5 commit 7ab78f9
Show file tree
Hide file tree
Showing 2 changed files with 35 additions and 16 deletions.
43 changes: 31 additions & 12 deletions System/FilePath/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -202,7 +202,7 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH")
-- | Split on the extension. 'addExtension' is the inverse.
--
-- > uncurry (++) (splitExtension x) == x
-- > uncurry addExtension (splitExtension x) == x
-- > Valid x => uncurry addExtension (splitExtension x) == x
-- > splitExtension "file.txt" == ("file",".txt")
-- > splitExtension "file" == ("file","")
-- > splitExtension "file/file.txt" == ("file/file",".txt")
Expand All @@ -211,12 +211,12 @@ getSearchPath = fmap splitSearchPath (getEnv "PATH")
-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
-- > splitExtension "file/path.txt/" == ("file/path.txt/","")
splitExtension :: FilePath -> (String, String)
splitExtension x = case d of
splitExtension x = case nameDot of
"" -> (x,"")
(y:ys) -> (a ++ reverse ys, y : reverse c)
_ -> (dir ++ init nameDot, extSeparator : ext)
where
(a,b) = splitFileName_ x
(c,d) = break isExtSeparator $ reverse b
(dir,file) = splitFileName_ x
(nameDot,ext) = breakEnd isExtSeparator file

-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
Expand Down Expand Up @@ -274,7 +274,7 @@ hasExtension = any isExtSeparator . takeFileName
-- | Split on all extensions
--
-- > uncurry (++) (splitExtensions x) == x
-- > uncurry addExtension (splitExtensions x) == x
-- > Valid x => uncurry addExtension (splitExtensions x) == x
-- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
splitExtensions :: FilePath -> (FilePath, String)
splitExtensions x = (a ++ c, d)
Expand Down Expand Up @@ -444,10 +444,10 @@ splitFileName x = (if null dir then "./" else dir, name)
-- look strange and upset simple equality properties. See
-- e.g. replaceFileName.
splitFileName_ :: FilePath -> (String, String)
splitFileName_ x = (c ++ reverse b, reverse a)
splitFileName_ x = (drv ++ dir, file)
where
(a,b) = break isPathSeparator $ reverse d
(c,d) = splitDrive x
(drv,pth) = splitDrive x
(dir,file) = breakEnd isPathSeparator pth

-- | Set the filename.
--
Expand Down Expand Up @@ -528,7 +528,7 @@ addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pat
dropTrailingPathSeparator :: FilePath -> FilePath
dropTrailingPathSeparator x =
if hasTrailingPathSeparator x && not (isDrive x)
then let x' = reverse $ dropWhile isPathSeparator $ reverse x
then let x' = dropWhileEnd isPathSeparator x
in if null x' then [last x] else x'
else x

Expand Down Expand Up @@ -807,7 +807,7 @@ isValid _ | isPosix = True
isValid path =
not (any (`elem` badCharacters) x2) &&
not (any f $ splitDirectories x2) &&
not (length x1 >= 2 && all isPathSeparator x1) &&
not (isJust (readDriveShare x1) && all isPathSeparator x1) &&
not (isJust (readDriveUNC x1) && not (hasTrailingPathSeparator x1))
where
(x1,x2) = splitDrive path
Expand All @@ -832,7 +832,7 @@ makeValid :: FilePath -> FilePath
makeValid "" = "_"
makeValid path
| isPosix = path
| length drv >= 2 && all isPathSeparator drv = take 2 drv ++ "drive"
| isJust (readDriveShare drv) && all isPathSeparator drv = take 2 drv ++ "drive"
| isJust (readDriveUNC drv) && not (hasTrailingPathSeparator drv) =
makeValid (drv ++ [pathSeparator] ++ pth)
| otherwise = joinDrive drv $ validElements $ validChars pth
Expand Down Expand Up @@ -891,3 +891,22 @@ isRelativeDrive x =
-- > isAbsolute x == not (isRelative x)
isAbsolute :: FilePath -> Bool
isAbsolute = not . isRelative


-----------------------------------------------------------------------------
-- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])
-- Note that Data.List.dropWhileEnd is only available in base >= 4.5.
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd p = reverse . dropWhile p . reverse

-- takeWhileEnd (>2) [1,2,3,4,1,2,3,4] == [3,4])
takeWhileEnd :: (a -> Bool) -> [a] -> [a]
takeWhileEnd p = reverse . takeWhile p . reverse

-- spanEnd (>2) [1,2,3,4,1,2,3,4] = ([1,2,3,4,1,2], [3,4])
spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
spanEnd p xs = (dropWhileEnd p xs, takeWhileEnd p xs)

-- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4])
breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
breakEnd p = spanEnd (not . p)
8 changes: 4 additions & 4 deletions tests/TestGen.hs
Original file line number Diff line number Diff line change
Expand Up @@ -536,9 +536,9 @@ block11 = do
putStrLn "Test 253, from line 204"
test (\ (QFilePath x) -> (uncurry ( ++ ) ( P.splitExtension x ) == x))
putStrLn "Test 254, from line 205"
test (\ (QFilePath x) -> (uncurry W.addExtension ( W.splitExtension x ) == x))
test (\ (QFilePath x) -> ((\ x -> uncurry W.addExtension ( W.splitExtension x ) == x ) ( W.makeValid x )))
putStrLn "Test 255, from line 205"
test (\ (QFilePath x) -> (uncurry P.addExtension ( P.splitExtension x ) == x))
test (\ (QFilePath x) -> ((\ x -> uncurry P.addExtension ( P.splitExtension x ) == x ) ( P.makeValid x )))
putStrLn "Test 256, from line 223"
test (\ (QFilePath x) -> (W.takeExtension x == snd ( W.splitExtension x )))
putStrLn "Test 257, from line 223"
Expand Down Expand Up @@ -568,9 +568,9 @@ block11 = do
putStrLn "Test 269, from line 276"
test (\ (QFilePath x) -> (uncurry ( ++ ) ( P.splitExtensions x ) == x))
putStrLn "Test 270, from line 277"
test (\ (QFilePath x) -> (uncurry W.addExtension ( W.splitExtensions x ) == x))
test (\ (QFilePath x) -> ((\ x -> uncurry W.addExtension ( W.splitExtensions x ) == x ) ( W.makeValid x )))
putStrLn "Test 271, from line 277"
test (\ (QFilePath x) -> (uncurry P.addExtension ( P.splitExtensions x ) == x))
test (\ (QFilePath x) -> ((\ x -> uncurry P.addExtension ( P.splitExtensions x ) == x ) ( P.makeValid x )))
putStrLn "Test 272, from line 287"
test (\ (QFilePath x) -> (not $ W.hasExtension ( W.dropExtensions x )))
putStrLn "Test 273, from line 287"
Expand Down

0 comments on commit 7ab78f9

Please sign in to comment.