Fix stripDir p p /= Nothing bug

This commit is contained in:
Chris Done 2015-05-27 17:08:03 +02:00
parent 8f3b169760
commit 4e1816392a
4 changed files with 12 additions and 3 deletions

View File

@ -9,3 +9,6 @@
0.4.0: 0.4.0:
* Implemented stricter parsing, disabling use of "..". * Implemented stricter parsing, disabling use of "..".
* Made stripDir generic over MonadThrow * Made stripDir generic over MonadThrow
0.5.0:
* Fix stripDir p p /= Nothing bug.

View File

@ -1,5 +1,5 @@
name: path name: path
version: 0.4.0 version: 0.5.0
synopsis: Path synopsis: Path
description: Path description: Path
license: BSD3 license: BSD3
@ -10,6 +10,7 @@ copyright: 2015 FP Complete
category: Filesystem category: Filesystem
build-type: Simple build-type: Simple
cabal-version: >=1.8 cabal-version: >=1.8
extra-source-files: README.md, CHANGELOG
library library
hs-source-dirs: src/ hs-source-dirs: src/

View File

@ -244,9 +244,10 @@ toFilePath (Path l) = l
stripDir :: MonadThrow m stripDir :: MonadThrow m
=> Path b Dir -> Path b t -> m (Path Rel t) => Path b Dir -> Path b t -> m (Path Rel t)
stripDir (Path p) (Path l) = stripDir (Path p) (Path l) =
case fmap Path (stripPrefix p l) of case stripPrefix p l of
Nothing -> throwM (Couldn'tStripPrefixDir p l) 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 -- | Is p a parent of the given location? Implemented in terms of
-- 'stripDir'. The bases must match. -- 'stripDir'. The bases must match.

View File

@ -101,6 +101,10 @@ operationStripDir =
($(mkRelDir "bar/") </> ($(mkRelDir "bar/") </>
$(mkRelFile "bob/foo.txt")) == $(mkRelFile "bob/foo.txt")) ==
Just $(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. -- | The '</>' operation.
operationAppend :: Spec operationAppend :: Spec