From 4e1816392a5b7f9d036d4d5574aa38a9a424526e Mon Sep 17 00:00:00 2001
From: Chris Done <chrisdone@gmail.com>
Date: Wed, 27 May 2015 17:08:03 +0200
Subject: [PATCH] Fix stripDir p p /= Nothing bug

---
 CHANGELOG    | 3 +++
 path.cabal   | 3 ++-
 src/Path.hs  | 5 +++--
 test/Main.hs | 4 ++++
 4 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG b/CHANGELOG
index 6d75279..673165a 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -9,3 +9,6 @@
 0.4.0:
 	* Implemented stricter parsing, disabling use of "..".
 	* Made stripDir generic over MonadThrow
+
+0.5.0:
+	* Fix stripDir p p /= Nothing bug.
diff --git a/path.cabal b/path.cabal
index 45d1ceb..c8dd984 100644
--- a/path.cabal
+++ b/path.cabal
@@ -1,5 +1,5 @@
 name:                path
-version:             0.4.0
+version:             0.5.0
 synopsis:            Path
 description:         Path
 license:             BSD3
@@ -10,6 +10,7 @@ copyright:           2015 FP Complete
 category:            Filesystem
 build-type:          Simple
 cabal-version:       >=1.8
+extra-source-files:  README.md, CHANGELOG
 
 library
   hs-source-dirs:    src/
diff --git a/src/Path.hs b/src/Path.hs
index e7e8960..9df53af 100644
--- a/src/Path.hs
+++ b/src/Path.hs
@@ -244,9 +244,10 @@ toFilePath (Path l) = l
 stripDir :: MonadThrow m
          => Path b Dir -> Path b t -> m (Path Rel t)
 stripDir (Path p) (Path l) =
-  case fmap Path (stripPrefix p l) of
+  case stripPrefix p l of
     Nothing -> throwM (Couldn'tStripPrefixDir p l)
-    Just ok -> return ok
+    Just "" -> throwM (Couldn'tStripPrefixDir p l)
+    Just ok -> return (Path ok)
 
 -- | Is p a parent of the given location? Implemented in terms of
 -- 'stripDir'. The bases must match.
diff --git a/test/Main.hs b/test/Main.hs
index 42bc906..6983a9d 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -101,6 +101,10 @@ operationStripDir =
                   ($(mkRelDir "bar/") </>
                    $(mkRelFile "bob/foo.txt")) ==
          Just $(mkRelFile "bob/foo.txt"))
+     it "stripDir parent parent = _|_"
+        (stripDir $(mkAbsDir "/home/chris/foo")
+                  $(mkAbsDir "/home/chris/foo") ==
+         Nothing)
 
 -- | The '</>' operation.
 operationAppend :: Spec