[commit: packages/filepath] master: #43, add stripExtension (2566d68)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/filepath

On branch  : master
Link       : http://git.haskell.org/packages/filepath.git/commitdiff/2566d68dc7e96513f8a1d2e5ff6799f26b948360

>---------------------------------------------------------------

commit 2566d68dc7e96513f8a1d2e5ff6799f26b948360
Author: Neil Mitchell <ndmitchell at gmail.com>
Date:   Tue Dec 22 14:05:03 2015 +0000

    #43, add stripExtension


>---------------------------------------------------------------

2566d68dc7e96513f8a1d2e5ff6799f26b948360
 System/FilePath/Internal.hs | 32 ++++++++++++++++++++++++++++++++
 changelog.md                |  2 +-
 tests/TestGen.hs            | 18 ++++++++++++++++++
 3 files changed, 51 insertions(+), 1 deletion(-)

diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs
index 2757c10..4572ae7 100644
--- a/System/FilePath/Internal.hs
+++ b/System/FilePath/Internal.hs
@@ -76,6 +76,7 @@ module System.FilePath.MODULE_NAME
     splitExtension,
     takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>),
     splitExtensions, dropExtensions, takeExtensions, replaceExtensions,
+    stripExtension,
 
     -- * Filename\/directory functions
     splitFileName,
@@ -104,6 +105,7 @@ module System.FilePath.MODULE_NAME
 
 import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
 import Data.Maybe(isJust)
+import Data.List(stripPrefix)
 
 import System.Environment(getEnv)
 
@@ -310,6 +312,30 @@ hasExtension :: FilePath -> Bool
 hasExtension = any isExtSeparator . takeFileName
 
 
+-- | Drop the given extension from a FilePath, and the \".\" preceding it.
+--
+-- It returns Nothing if the FilePath does not have the extension given, or
+-- Just the part before the extension, if it does.
+--
+-- It is safer to use this function than System.FilePath.dropExtensions,
+-- because FilePath might be something like 'file.name.ext1.ext2', where we
+-- want to only drop the 'ext1.ext2' part, but keep the full 'file.name' part.
+--
+-- > stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x"
+-- > stripExtension "hi.o" "foo.x.hs.o" == Nothing
+-- > dropExtension x == fromJust (stripExtension (takeExtension x) x)
+-- > dropExtensions x == fromJust (stripExtension (takeExtensions x) x)
+-- > stripExtension ".c.d" "a.b.c.d"  == Just "a.b"
+-- > stripExtension ".c.d" "a.b..c.d" == Just "a.b."
+-- > stripExtension "baz"  "foo.bar"  == Nothing
+-- > stripExtension "bar"  "foobar"   == Nothing
+-- > stripExtension ""     x          == Just x
+stripExtension :: String -> FilePath -> Maybe FilePath
+stripExtension []        path = Just path
+stripExtension ext@(x:_) path = stripSuffix dotExt path
+    where dotExt = if isExtSeparator x then ext else '.':ext
+
+
 -- | Split on all extensions.
 --
 -- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext")
@@ -996,3 +1022,9 @@ 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)
+
+-- | The stripSuffix function drops the given suffix from a list. It returns
+-- Nothing if the list did not end with the suffix given, or Just the list
+-- before the suffix, if it does.
+stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
+stripSuffix xs ys = reverse <$> stripPrefix (reverse xs) (reverse ys)
diff --git a/changelog.md b/changelog.md
index 976d006..7d3f943 100644
--- a/changelog.md
+++ b/changelog.md
@@ -4,7 +4,7 @@ _Note: below all `FilePath` values are unquoted, so `\\` really means two backsl
 
 ## 1.4.1.0  *Unreleased*
 
- * Add `replaceExtensions` function.
+ * Add `replaceExtensions` and `stripExtension` functions.
 
  * Make `isValid` detect more invalid Windows paths, e.g. `nul .txt` and `foo\nbar`.
 
diff --git a/tests/TestGen.hs b/tests/TestGen.hs
index 93733e6..ce5b21c 100755
--- a/tests/TestGen.hs
+++ b/tests/TestGen.hs
@@ -105,6 +105,24 @@ tests =
     ,("W.hasExtension \"/directory/path\" == False", test $ W.hasExtension "/directory/path" == False)
     ,("null (P.takeExtension x) == not (P.hasExtension x)", test $ \(QFilePath x) -> null (P.takeExtension x) == not (P.hasExtension x))
     ,("null (W.takeExtension x) == not (W.hasExtension x)", test $ \(QFilePath x) -> null (W.takeExtension x) == not (W.hasExtension x))
+    ,("P.stripExtension \"hs.o\" \"foo.x.hs.o\" == Just \"foo.x\"", test $ P.stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x")
+    ,("W.stripExtension \"hs.o\" \"foo.x.hs.o\" == Just \"foo.x\"", test $ W.stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x")
+    ,("P.stripExtension \"hi.o\" \"foo.x.hs.o\" == Nothing", test $ P.stripExtension "hi.o" "foo.x.hs.o" == Nothing)
+    ,("W.stripExtension \"hi.o\" \"foo.x.hs.o\" == Nothing", test $ W.stripExtension "hi.o" "foo.x.hs.o" == Nothing)
+    ,("P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x)", test $ \(QFilePath x) -> P.dropExtension x == fromJust (P.stripExtension (P.takeExtension x) x))
+    ,("W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x)", test $ \(QFilePath x) -> W.dropExtension x == fromJust (W.stripExtension (W.takeExtension x) x))
+    ,("P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x)", test $ \(QFilePath x) -> P.dropExtensions x == fromJust (P.stripExtension (P.takeExtensions x) x))
+    ,("W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x)", test $ \(QFilePath x) -> W.dropExtensions x == fromJust (W.stripExtension (W.takeExtensions x) x))
+    ,("P.stripExtension \".c.d\" \"a.b.c.d\" == Just \"a.b\"", test $ P.stripExtension ".c.d" "a.b.c.d" == Just "a.b")
+    ,("W.stripExtension \".c.d\" \"a.b.c.d\" == Just \"a.b\"", test $ W.stripExtension ".c.d" "a.b.c.d" == Just "a.b")
+    ,("P.stripExtension \".c.d\" \"a.b..c.d\" == Just \"a.b.\"", test $ P.stripExtension ".c.d" "a.b..c.d" == Just "a.b.")
+    ,("W.stripExtension \".c.d\" \"a.b..c.d\" == Just \"a.b.\"", test $ W.stripExtension ".c.d" "a.b..c.d" == Just "a.b.")
+    ,("P.stripExtension \"baz\" \"foo.bar\" == Nothing", test $ P.stripExtension "baz" "foo.bar" == Nothing)
+    ,("W.stripExtension \"baz\" \"foo.bar\" == Nothing", test $ W.stripExtension "baz" "foo.bar" == Nothing)
+    ,("P.stripExtension \"bar\" \"foobar\" == Nothing", test $ P.stripExtension "bar" "foobar" == Nothing)
+    ,("W.stripExtension \"bar\" \"foobar\" == Nothing", test $ W.stripExtension "bar" "foobar" == Nothing)
+    ,("P.stripExtension \"\" x == Just x", test $ \(QFilePath x) -> P.stripExtension "" x == Just x)
+    ,("W.stripExtension \"\" x == Just x", test $ \(QFilePath x) -> W.stripExtension "" x == Just x)
     ,("P.splitExtensions \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", test $ P.splitExtensions "/directory/path.ext" == ("/directory/path", ".ext"))
     ,("W.splitExtensions \"/directory/path.ext\" == (\"/directory/path\", \".ext\")", test $ W.splitExtensions "/directory/path.ext" == ("/directory/path", ".ext"))
     ,("P.splitExtensions \"file.tar.gz\" == (\"file\", \".tar.gz\")", test $ P.splitExtensions "file.tar.gz" == ("file", ".tar.gz"))