Fix stripDir p p /= Nothing bug

2015-05-27 17:08:03 +02:00
parent 8f3b169760
commit 4e1816392a
4 changed files with 12 additions and 3 deletions
--- 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.