path 0.5.11 → 0.5.12
raw patch · 5 files changed
+249/−72 lines, 5 filesdep +hashabledep ~aesondep ~basedep ~deepseq
Dependencies added: hashable
Dependency ranges changed: aeson, base, deepseq, exceptions, filepath, genvalidity, genvalidity-hspec, template-haskell, validity
Files
- path.cabal +28/−5
- src/Path/Internal.hs +5/−1
- test/Main.hs +35/−62
- test/Path/Gen.hs +18/−4
- test/ValidityTest.hs +163/−0
path.cabal view
@@ -1,5 +1,5 @@ name: path-version: 0.5.11+version: 0.5.12 synopsis: Support for well-typed paths description: Support for well-typed paths. license: BSD3@@ -12,6 +12,11 @@ cabal-version: >=1.8 extra-source-files: README.md, CHANGELOG +flag validity+ manual: True+ default: False+ description: Enable validity tests.+ library hs-source-dirs: src/ ghc-options: -Wall -O2@@ -22,11 +27,11 @@ , template-haskell , deepseq , aeson+ , hashable >= 1.2 && < 1.3 test-suite test type: exitcode-stdio-1.0 main-is: Main.hs- other-modules: Path.Gen hs-source-dirs: test build-depends: HUnit , QuickCheck@@ -34,12 +39,30 @@ , base , bytestring , filepath- , genvalidity- , genvalidity-hspec , hspec , mtl , path- , validity++test-suite validity-test+ if !flag(validity)+ buildable: False+ type: exitcode-stdio-1.0+ main-is: ValidityTest.hs+ other-modules: Path.Gen+ hs-source-dirs: test+ if flag(validity)+ build-depends: HUnit+ , QuickCheck+ , aeson+ , base >= 4.9 && < 5+ , bytestring+ , filepath+ , genvalidity >= 0.3 && < 0.4+ , genvalidity-hspec >= 0.3 && < 0.4+ , hspec+ , mtl+ , path+ , validity >= 0.3.1.1 && < 0.4 source-repository head type: git
src/Path/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} -- | Internal types and functions.@@ -10,6 +10,7 @@ import Control.DeepSeq (NFData (..)) import Data.Aeson (ToJSON (..)) import Data.Data+import Data.Hashable -- | Path of some base and type. --@@ -57,3 +58,6 @@ toEncoding (Path x) = toEncoding x {-# INLINE toEncoding #-} #endif++instance Hashable (Path b t) where+ hashWithSalt n (Path path) = hashWithSalt n path
test/Main.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | Test suite. @@ -12,9 +13,7 @@ import Path import Path.Internal import Test.Hspec-import Test.Validity--import Path.Gen ()+import Test.QuickCheck -- | Test suite entry point, returns exit failure if any test fails. main :: IO ()@@ -32,6 +31,7 @@ describe "Operations: isParentOf" operationIsParentOf describe "Operations: parent" operationParent describe "Operations: filename" operationFilename+ describe "Operations: dirname" operationDirname describe "Restrictions" restrictions describe "Aeson Instances" aesonInstances @@ -50,32 +50,44 @@ parseFails "/.." parseFails "/foo/../bar/" parseFails "/foo/bar/.."+ parseFailsPending "/hello/\n/world"+ parseFailsPending "white/\r/space" where parseFails x = it (show x ++ " should be rejected") (isNothing (void (parseAbsDir x) <|> void (parseRelDir x) <|> void (parseAbsFile x) <|> void (parseRelFile x)))+ parseFailsPending x =+ it (show x ++ " should be rejected")+ pending parseSucceeds x with = parserTest parseRelDir x (Just with) +-- | The 'dirname' operation.+operationDirname :: Spec+operationDirname = do+ it+ "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"+ (dirname ($(mkAbsDir "/home/chris/") </> $(mkRelDir "bar")) ==+ dirname $(mkRelDir "bar"))+ it+ "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"+ (dirname ($(mkRelDir "home/chris/") </> $(mkRelDir "bar")) ==+ dirname $(mkRelDir "bar"))+ -- | The 'filename' operation. operationFilename :: Spec operationFilename =- do it "filename ($(mkAbsDir parent) </> filename $(mkRelFile filename)) == $(mkRelFile filename)"- (filename ($(mkAbsDir "/home/chris/") </>- filename $(mkRelFile "bar.txt")) ==- $(mkRelFile "bar.txt"))- it "filename ($(mkRelDir parent) </> filename $(mkRelFile filename)) == $(mkRelFile filename)"- (filename ($(mkRelDir "home/chris/") </>- 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)+ do it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"+ (filename ($(mkAbsDir "/home/chris/") </>+ $(mkRelFile "bar.txt")) ==+ filename $(mkRelFile "bar.txt")) - it "produces a valid path on when passed a valid relative path" $ do- producesValidsOnValids (filename :: Path Rel File -> Path Rel File)+ it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"+ (filename ($(mkRelDir "home/chris/") </>+ $(mkRelFile "bar.txt")) ==+ filename $(mkRelFile "bar.txt")) -- | The 'parent' operation. operationParent :: Spec@@ -91,21 +103,16 @@ (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 =- do it "isParentOf parent (parent </> child)"+ do it "isParentOf parent (parent </> child) (unit test)" (isParentOf $(mkAbsDir "///bar/") ($(mkAbsDir "///bar/") </> $(mkRelFile "bar/foo.txt")))- it "isParentOf parent (parent </> child)"++ it "isParentOf parent (parent </> child) (unit test)" (isParentOf $(mkRelDir "bar/") ($(mkRelDir "bar/") </>@@ -114,33 +121,23 @@ -- | The 'stripDir' operation. operationStripDir :: Spec operationStripDir =- do it "stripDir parent (parent </> child) = child"+ do it "stripDir parent (parent </> child) = child (unit test)" (stripDir $(mkAbsDir "///bar/") ($(mkAbsDir "///bar/") </> $(mkRelFile "bar/foo.txt")) == Just $(mkRelFile "bar/foo.txt"))- it "stripDir parent (parent </> child) = child"++ it "stripDir parent (parent </> child) = child (unit test)" (stripDir $(mkRelDir "bar/") ($(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) - 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 =@@ -161,18 +158,6 @@ $(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 =@@ -185,9 +170,6 @@ 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) @@ -214,9 +196,6 @@ 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) @@ -237,9 +216,6 @@ 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) @@ -270,9 +246,6 @@ 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
@@ -19,6 +19,7 @@ && not (FilePath.hasTrailingPathSeparator fp) && FilePath.isValid fp && not (".." `isInfixOf` fp)+ && not (containsLineBreaks fp) && (parseAbsFile fp == Just p) instance Validity (Path Rel File) where@@ -29,6 +30,7 @@ && fp /= "." && fp /= ".." && not (".." `isInfixOf` fp)+ && not (containsLineBreaks fp) && (parseRelFile fp == Just p) instance Validity (Path Abs Dir) where@@ -37,6 +39,7 @@ && FilePath.hasTrailingPathSeparator fp && FilePath.isValid fp && not (".." `isInfixOf` fp)+ && not (containsLineBreaks fp) && (parseAbsDir fp == Just p) instance Validity (Path Rel Dir) where@@ -48,19 +51,30 @@ && fp /= "." && fp /= ".." && not (".." `isInfixOf` fp)+ && not (containsLineBreaks fp) && (parseRelDir fp == Just p) +containsLineBreaks :: String -> Bool+containsLineBreaks s = any (`elem` s) "\n\r" -instance GenValidity (Path Abs File) where+instance GenUnchecked (Path Abs File) where genUnchecked = Path <$> arbitrary -instance GenValidity (Path Rel File) where+instance GenValid (Path Abs File)++instance GenUnchecked (Path Rel File) where genUnchecked = Path <$> arbitrary -instance GenValidity (Path Abs Dir) where+instance GenValid (Path Rel File)++instance GenUnchecked (Path Abs Dir) where genUnchecked = Path <$> arbitrary -instance GenValidity (Path Rel Dir) where+instance GenValid (Path Abs Dir)++instance GenUnchecked (Path Rel Dir) where genUnchecked = Path <$> arbitrary++instance GenValid (Path Rel Dir)
+ test/ValidityTest.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Test suite.++module Main where++import Control.Applicative+import Control.Monad+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Maybe+import Path+import Path.Internal+import Test.Hspec+import Test.QuickCheck+import Test.Validity++import Path.Gen ()++-- | Test suite entry point, returns exit failure if any test fails.+main :: IO ()+main = hspec spec++-- | Test suite.+spec :: Spec+spec = do+ describe "Parsing: Path Abs Dir" parseAbsDirSpec+ describe "Parsing: Path Rel Dir" parseRelDirSpec+ describe "Parsing: Path Abs File" parseAbsFileSpec+ describe "Parsing: Path Rel File" parseRelFileSpec+ describe "Operations: (</>)" operationAppend+ describe "Operations: stripDir" operationStripDir+ describe "Operations: isParentOf" operationIsParentOf+ describe "Operations: parent" operationParent+ describe "Operations: filename" operationFilename++-- | The 'filename' operation.+operationFilename :: Spec+operationFilename = do+ it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $+ forAll genValid $ \(parent :: Path Abs Dir) ->+ forAll genValid $ \file ->+ filename (parent </> file) `shouldBe` filename file++ it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $+ forAll genValid $ \(parent :: Path Rel Dir) ->+ forAll genValid $ \file ->+ filename (parent </> file) `shouldBe` filename file++ it "produces a valid path on when passed a valid absolute path" $ do+ producesValidsOnValids (filename @Abs)++ it "produces a valid path on when passed a valid relative path" $ do+ producesValidsOnValids (filename @Rel)++-- | The 'parent' operation.+operationParent :: Spec+operationParent = do+ it "produces a valid path on when passed a valid file path" $ do+ producesValidsOnValids (parent @File)++ it "produces a valid path on when passed a valid directory path" $ do+ producesValidsOnValids (parent @Dir)++-- | The 'isParentOf' operation.+operationIsParentOf :: Spec+operationIsParentOf = do+ it "isParentOf parent (parent </> child)" $+ forAll genValid $ \(parent :: Path Abs Dir) ->+ forAll genValid $ \(child :: Path Rel File) ->+ isParentOf parent (parent </> child)++ it "isParentOf parent (parent </> child)" $+ forAll genValid $ \(parent :: Path Abs Dir) ->+ forAll genValid $ \(child :: Path Rel Dir) ->+ isParentOf parent (parent </> child)++ it "isParentOf parent (parent </> child)" $+ forAll genValid $ \(parent :: Path Rel Dir) ->+ forAll genValid $ \(child :: Path Rel File) ->+ isParentOf parent (parent </> child)++ it "isParentOf parent (parent </> child)" $+ forAll genValid $ \(parent :: Path Rel Dir) ->+ forAll genValid $ \(child :: Path Rel Dir) ->+ isParentOf parent (parent </> child)++-- | The 'stripDir' operation.+operationStripDir :: Spec+operationStripDir = do+ it "stripDir parent (parent </> child) = child" $+ forAll genValid $ \(parent :: Path Abs Dir) ->+ forAll genValid $ \(child :: Path Rel File) ->+ stripDir parent (parent </> child) == Just child++ it "stripDir parent (parent </> child) = child" $+ forAll genValid $ \(parent :: Path Rel Dir) ->+ forAll genValid $ \(child :: Path Rel File) ->+ stripDir parent (parent </> child) == Just child++ it "stripDir parent (parent </> child) = child" $+ forAll genValid $ \(parent :: Path Abs Dir) ->+ forAll genValid $ \(child :: Path Rel Dir) ->+ stripDir parent (parent </> child) == Just child++ it "stripDir parent (parent </> child) = child" $+ forAll genValid $ \(parent :: Path Rel Dir) ->+ forAll genValid $ \(child :: Path Rel Dir) ->+ stripDir parent (parent </> child) == Just child+ + it "produces a valid path on when passed a valid absolute file paths" $ do+ producesValidsOnValids2 (stripDir @Maybe @Abs @File)++ it "produces a valid path on when passed a valid absolute directory paths" $ do+ producesValidsOnValids2 (stripDir @Maybe @Abs @Dir)++ it "produces a valid path on when passed a valid relative file paths" $ do+ producesValidsOnValids2 (stripDir @Maybe @Rel @File)++ it "produces a valid path on when passed a valid relative directory paths" $ do+ producesValidsOnValids2 (stripDir @Maybe @Rel @Dir)++-- | The '</>' operation.+operationAppend :: Spec+operationAppend = do+ it "produces a valid path on when creating valid absolute file paths" $ do+ producesValidsOnValids2 ((</>) @Abs @File)++ it "produces a valid path on when creating valid absolute directory paths" $ do+ producesValidsOnValids2 ((</>) @Abs @Dir)++ it "produces a valid path on when creating valid relative file paths" $ do+ producesValidsOnValids2 ((</>) @Rel @File)++ it "produces a valid path on when creating valid relative directory paths" $ do+ producesValidsOnValids2 ((</>) @Rel @Dir)+++parseAbsDirSpec :: Spec+parseAbsDirSpec = do+ it "Produces valid paths when it succeeds" $+ validIfSucceedsOnArbitrary+ (parseAbsDir @Maybe)++parseRelDirSpec :: Spec+parseRelDirSpec = do+ it "Produces valid paths when it succeeds" $+ validIfSucceedsOnArbitrary+ (parseRelDir @Maybe)++parseAbsFileSpec :: Spec+parseAbsFileSpec = do+ it "Produces valid paths when it succeeds" $+ validIfSucceedsOnArbitrary+ (parseAbsFile @Maybe)++parseRelFileSpec :: Spec+parseRelFileSpec = do+ it "Produces valid paths when it succeeds" $+ validIfSucceedsOnArbitrary+ (parseRelFile @Maybe)