path 0.3.0 → 0.4.0
raw patch · 3 files changed
+58/−9 lines, 3 files
Files
- path.cabal +5/−1
- src/Path.hs +31/−8
- test/Main.hs +22/−0
path.cabal view
@@ -1,5 +1,5 @@ name: path-version: 0.3.0+version: 0.4.0 synopsis: Path description: Path license: BSD3@@ -29,3 +29,7 @@ , hspec , mtl , path++source-repository head+ type: git+ location: https://github.com/chrisdone/path.git
src/Path.hs view
@@ -65,6 +65,7 @@ | InvalidRelDir FilePath | InvalidAbsFile FilePath | InvalidRelFile FilePath+ | Couldn'tStripPrefixDir FilePath FilePath deriving (Show,Typeable) instance Exception PathParseException @@ -81,7 +82,10 @@ parseAbsDir filepath = if FilePath.isAbsolute filepath && not (null (normalizeDir filepath)) &&- not (isPrefixOf "~/" filepath)+ not (isPrefixOf "~/" filepath) &&+ not (isSuffixOf "/.." filepath) &&+ not (isInfixOf "/../" filepath) &&+ not (isPrefixOf "../" filepath) then return (Path (normalizeDir filepath)) else throwM (InvalidAbsDir filepath) @@ -96,7 +100,11 @@ if not (FilePath.isAbsolute filepath) && not (null filepath) && not (isPrefixOf "~/" filepath) &&- not (null (normalizeDir filepath))+ not (isPrefixOf "../" filepath) &&+ not (isSuffixOf "/.." filepath) &&+ not (isInfixOf "/../" filepath) &&+ not (null (normalizeDir filepath)) &&+ filepath /= ".." then return (Path (normalizeDir filepath)) else throwM (InvalidRelDir filepath) @@ -110,7 +118,11 @@ if FilePath.isAbsolute filepath && not (FilePath.hasTrailingPathSeparator filepath) && not (isPrefixOf "~/" filepath) &&- not (null (normalizeFile filepath))+ not (isPrefixOf "../" filepath) &&+ not (isSuffixOf "/.." filepath) &&+ not (isInfixOf "/../" filepath) &&+ not (null (normalizeFile filepath)) &&+ filepath /= ".." then return (Path (normalizeFile filepath)) else throwM (InvalidAbsFile filepath) @@ -121,10 +133,16 @@ parseRelFile :: MonadThrow m => FilePath -> m (Path Rel File) parseRelFile filepath =- if not (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) &&+ if not (FilePath.isAbsolute filepath ||+ FilePath.hasTrailingPathSeparator filepath) && not (null filepath) && not (isPrefixOf "~/" filepath) &&- not (null (normalizeFile filepath))+ not (isPrefixOf "../" filepath) &&+ not (isInfixOf "/../" filepath) &&+ not (isSuffixOf "/.." filepath) &&+ not (isInfixOf "/../" filepath) &&+ not (null (normalizeFile filepath)) &&+ filepath /= ".." then return (Path (normalizeFile filepath)) else throwM (InvalidRelFile filepath) @@ -217,13 +235,18 @@ -- -- @stripDir (a :: Path Abs …) (b :: Path Rel …)@ ----- @stripDir (a :: Path Rel) (b :: Path Abs …)@+-- @stripDir (a :: Path Rel …) (b :: Path Abs …)@ -- -- In other words the bases must match. ---stripDir :: Path b Dir -> Path b t -> Maybe (Path Rel t)+-- Throws: 'Couldn'tStripPrefixDir'+--+stripDir :: MonadThrow m+ => Path b Dir -> Path b t -> m (Path Rel t) stripDir (Path p) (Path l) =- fmap Path (stripPrefix p l)+ case fmap Path (stripPrefix p l) of+ Nothing -> throwM (Couldn'tStripPrefixDir p l)+ Just ok -> return ok -- | Is p a parent of the given location? Implemented in terms of -- 'stripDir'. The bases must match.
test/Main.hs view
@@ -4,6 +4,9 @@ module Main where +import Control.Applicative+import Control.Monad+import Data.Maybe import Data.Monoid import Path import Path.Internal@@ -25,6 +28,25 @@ describe "Operations: isParentOf" operationIsParentOf describe "Operations: parent" operationParent describe "Operations: filename" operationFilename+ describe "Restrictions" restrictions++-- | Restricting the input of any tricks.+restrictions :: Spec+restrictions =+ do parseFails "~/"+ parseFails "~/foo"+ parseFails "~/foo/bar"+ parseFails "../"+ parseFails ".."+ parseFails "/.."+ parseFails "/foo/../bar/"+ parseFails "/foo/bar/.."+ where parseFails x =+ it (show x ++ " should be rejected")+ (isNothing (void (parseAbsDir x) <|>+ void (parseRelDir x) <|>+ void (parseAbsFile x) <|>+ void (parseRelDir x))) -- | The 'filename' operation. operationFilename :: Spec