path 0.5.9 → 0.5.10
raw patch · 5 files changed
+169/−15 lines, 5 filesdep +QuickCheckdep +genvaliditydep +genvalidity-hspecdep ~filepath
Dependencies added: QuickCheck, genvalidity, genvalidity-hspec, validity
Dependency ranges changed: filepath
Files
- CHANGELOG +4/−0
- path.cabal +7/−1
- src/Path.hs +30/−14
- test/Main.hs +62/−0
- test/Path/Gen.hs +66/−0
CHANGELOG view
@@ -1,3 +1,7 @@+0.5.10+ * Disallow /. for absolute file+ * Disallow foo/. for relative file+ 0.5.9: * Lifted ~ restriction from parser https://github.com/chrisdone/path/issues/19 0.5.8
path.cabal view
@@ -1,5 +1,5 @@ name: path-version: 0.5.9+version: 0.5.10 synopsis: Support for well-typed paths description: Support for well-typed paths. license: BSD3@@ -26,14 +26,20 @@ test-suite test type: exitcode-stdio-1.0 main-is: Main.hs+ other-modules: Path.Gen hs-source-dirs: test build-depends: HUnit+ , QuickCheck , aeson , base , bytestring+ , filepath+ , genvalidity+ , genvalidity-hspec , hspec , mtl , path+ , validity source-repository head type: git
src/Path.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE PatternGuards #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-}@@ -161,18 +162,27 @@ -- * is not an absolute path -- * has a trailing path separator -- * contains @..@ anywhere in the path+-- * ends in @/.@ -- * is not a valid path (See 'System.FilePath.isValid') -- parseAbsFile :: MonadThrow m => FilePath -> m (Path Abs File) parseAbsFile filepath =- if FilePath.isAbsolute filepath &&- not (FilePath.hasTrailingPathSeparator filepath) &&- not (hasParentDir filepath) &&- FilePath.isValid filepath- then return (Path (normalizeFilePath filepath))- else throwM (InvalidAbsFile filepath)+ case validAbsFile filepath of+ True+ | normalized <- normalizeFilePath filepath+ , validAbsFile normalized ->+ return (Path normalized)+ _ -> throwM (InvalidAbsFile filepath) +-- | Is the string a valid absolute file?+validAbsFile :: FilePath -> Bool+validAbsFile filepath =+ FilePath.isAbsolute filepath &&+ not (FilePath.hasTrailingPathSeparator filepath) &&+ not (hasParentDir filepath) &&+ FilePath.isValid filepath+ -- | Convert a relative 'FilePath' to a normalized relative file 'Path'. -- -- Throws: 'PathParseException' when the supplied path:@@ -186,14 +196,20 @@ parseRelFile :: MonadThrow m => FilePath -> m (Path Rel File) parseRelFile filepath =- if not (FilePath.isAbsolute filepath ||- FilePath.hasTrailingPathSeparator filepath) &&- not (null filepath) &&- not (hasParentDir filepath) &&- filepath /= "." && filepath /= ".." &&- FilePath.isValid filepath- then return (Path (normalizeFilePath filepath))- else throwM (InvalidRelFile filepath)+ case validRelFile filepath of+ True+ | normalized <- normalizeFilePath filepath+ , validRelFile normalized -> return (Path normalized)+ _ -> throwM (InvalidRelFile filepath)++-- | Is the string a valid relative file?+validRelFile :: FilePath -> Bool+validRelFile filepath =+ not+ (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) &&+ not (null filepath) &&+ not (hasParentDir filepath) &&+ filepath /= "." && filepath /= ".." && FilePath.isValid filepath -- | Helper function: check if the filepath has any parent directories in it. -- This handles the logic of checking for different path separators on Windows.
test/Main.hs view
@@ -12,7 +12,10 @@ import Path import Path.Internal import Test.Hspec+import Test.Validity +import Path.Gen ()+ -- | Test suite entry point, returns exit failure if any test fails. main :: IO () main = hspec spec@@ -68,6 +71,12 @@ filename $(mkRelFile "bar.txt")) == $(mkRelFile "bar.txt")) + it "produces a valid path on when passed a valid absolute path" $ do+ producesValidsOnValids (filename :: Path Abs File -> Path Rel File)++ it "produces a valid path on when passed a valid relative path" $ do+ producesValidsOnValids (filename :: Path Rel File -> Path Rel File)+ -- | The 'parent' operation. operationParent :: Spec operationParent =@@ -82,6 +91,12 @@ (parent (parent $(mkAbsDir "/")) == $(mkAbsDir "/")) + it "produces a valid path on when passed a valid file path" $ do+ producesValidsOnValids (parent :: Path Abs File -> Path Abs Dir)++ it "produces a valid path on when passed a valid directory path" $ do+ producesValidsOnValids (parent :: Path Abs Dir -> Path Abs Dir)+ -- | The 'isParentOf' operation. operationIsParentOf :: Spec operationIsParentOf =@@ -114,6 +129,18 @@ $(mkAbsDir "/home/chris/foo") == Nothing) + it "produces a valid path on when passed a valid absolute file paths" $ do+ producesValidsOnValids2 (stripDir :: Path Abs Dir -> Path Abs File -> Maybe (Path Rel File))++ it "produces a valid path on when passed a valid absolute directory paths" $ do+ producesValidsOnValids2 (stripDir :: Path Abs Dir -> Path Abs Dir -> Maybe (Path Rel Dir))++ it "produces a valid path on when passed a valid relative file paths" $ do+ producesValidsOnValids2 (stripDir :: Path Rel Dir -> Path Rel File -> Maybe (Path Rel File))++ it "produces a valid path on when passed a valid relative directory paths" $ do+ producesValidsOnValids2 (stripDir :: Path Rel Dir -> Path Rel Dir -> Maybe (Path Rel Dir))+ -- | The '</>' operation. operationAppend :: Spec operationAppend =@@ -134,6 +161,18 @@ $(mkRelFile "chris/test.txt") == $(mkRelFile "home/chris/test.txt")) + it "produces a valid path on when creating valid absolute file paths" $ do+ producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel File -> Path Abs File)++ it "produces a valid path on when creating valid absolute directory paths" $ do+ producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs Dir)++ it "produces a valid path on when creating valid relative file paths" $ do+ producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel File -> Path Rel File)++ it "produces a valid path on when creating valid relative directory paths" $ do+ producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir)+ -- | Tests for the tokenizer. parseAbsDirSpec :: Spec parseAbsDirSpec =@@ -145,6 +184,10 @@ succeeding "///foo//bar//mu/" (Path "/foo/bar/mu/") succeeding "///foo//bar////mu" (Path "/foo/bar/mu/") succeeding "///foo//bar/.//mu" (Path "/foo/bar/mu/")++ it "Produces valid paths when it succeeds" $+ validIfSucceedsOnArbitrary+ (parseAbsDir :: FilePath -> Maybe (Path Abs Dir)) where failing x = parserTest parseAbsDir x Nothing succeeding x with = parserTest parseAbsDir x (Just with) @@ -170,6 +213,10 @@ succeeding "foo//bar//mu//" (Path "foo/bar/mu/") succeeding "foo//bar////mu" (Path "foo/bar/mu/") succeeding "foo//bar/.//mu" (Path "foo/bar/mu/")++ it "Produces valid paths when it succeeds" $+ validIfSucceedsOnArbitrary+ (parseRelDir :: FilePath -> Maybe (Path Rel Dir)) where failing x = parserTest parseRelDir x Nothing succeeding x with = parserTest parseRelDir x (Just with) @@ -178,6 +225,8 @@ parseAbsFileSpec = do failing "" failing "./"+ failing "/."+ failing "/foo/bar/." failing "~/" failing "./foo.txt" failing "/"@@ -187,6 +236,10 @@ succeeding "/foo.txt" (Path "/foo.txt") succeeding "///foo//bar////mu.txt" (Path "/foo/bar/mu.txt") succeeding "///foo//bar/.//mu.txt" (Path "/foo/bar/mu.txt")++ it "Produces valid paths when it succeeds" $+ validIfSucceedsOnArbitrary+ (parseAbsFile :: FilePath -> Maybe (Path Abs File)) where failing x = parserTest parseAbsFile x Nothing succeeding x with = parserTest parseAbsFile x (Just with) @@ -199,10 +252,15 @@ failing "~/" failing "/" failing "./"+ failing "a/."+ failing "a/../b"+ failing "a/.."+ failing "../foo.txt" failing "//" failing "///foo//bar//mu/" failing "///foo//bar////mu" failing "///foo//bar/.//mu"+ succeeding "a.." (Path "a..") succeeding "..." (Path "...") succeeding "foo.txt" (Path "foo.txt") succeeding "./foo.txt" (Path "foo.txt")@@ -211,6 +269,10 @@ succeeding "foo//bar//mu.txt" (Path "foo/bar/mu.txt") succeeding "foo//bar////mu.txt" (Path "foo/bar/mu.txt") succeeding "foo//bar/.//mu.txt" (Path "foo/bar/mu.txt")++ it "Produces valid paths when it succeeds" $+ validIfSucceedsOnArbitrary+ (parseRelFile :: FilePath -> Maybe (Path Rel File)) where failing x = parserTest parseRelFile x Nothing succeeding x with = parserTest parseRelFile x (Just with)
+ test/Path/Gen.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleInstances #-}+module Path.Gen where++import Path+import Path.Internal++import qualified System.FilePath as FilePath++import Data.List (isInfixOf)+import Data.Validity+import Data.GenValidity++import Test.QuickCheck+++instance Validity (Path Abs File) where+ isValid p@(Path fp)+ = FilePath.isAbsolute fp+ && not (FilePath.hasTrailingPathSeparator fp)+ && FilePath.isValid fp+ && not (".." `isInfixOf` fp)+ && (parseAbsFile fp == Just p)++instance Validity (Path Rel File) where+ isValid p@(Path fp)+ = FilePath.isRelative fp+ && not (FilePath.hasTrailingPathSeparator fp)+ && FilePath.isValid fp+ && fp /= "."+ && fp /= ".."+ && not (".." `isInfixOf` fp)+ && (parseRelFile fp == Just p)++instance Validity (Path Abs Dir) where+ isValid p@(Path fp)+ = FilePath.isAbsolute fp+ && FilePath.hasTrailingPathSeparator fp+ && FilePath.isValid fp+ && not (".." `isInfixOf` fp)+ && (parseAbsDir fp == Just p)++instance Validity (Path Rel Dir) where+ isValid p@(Path fp)+ = FilePath.isRelative fp+ && FilePath.hasTrailingPathSeparator fp+ && FilePath.isValid fp+ && not (null fp)+ && fp /= "."+ && fp /= ".."+ && not (".." `isInfixOf` fp)+ && (parseRelDir fp == Just p)++++instance GenValidity (Path Abs File) where+ genUnchecked = Path <$> arbitrary++instance GenValidity (Path Rel File) where+ genUnchecked = Path <$> arbitrary++instance GenValidity (Path Abs Dir) where+ genUnchecked = Path <$> arbitrary++instance GenValidity (Path Rel Dir) where+ genUnchecked = Path <$> arbitrary+