path 0.9.0 → 0.9.1
raw patch · 5 files changed
+165/−145 lines, 5 filesdep ~genvaliditydep ~hashable
Dependency ranges changed: genvalidity, hashable
Files
- CHANGELOG +4/−0
- path.cabal +2/−2
- src/Path/Include.hs +25/−4
- test/Path/Gen.hs +66/−103
- test/ValidityTest.hs +68/−36
CHANGELOG view
@@ -1,3 +1,7 @@+0.9.1+ * Support for genvalidity >=1.0.0.0+ * `mapSomeBase` and `prjSomeBase` for modifying or projecting SomeBase.+ 0.9.0 * Fix inconsistencies on different platforms: [#166](https://github.com/commercialhaskell/path/issues/166) * `replaceProperPrefix`
path.cabal view
@@ -1,5 +1,5 @@ name: path-version: 0.9.0+version: 0.9.1 synopsis: Support for well-typed paths description: Support for well-typed paths. license: BSD3@@ -81,7 +81,7 @@ , base >= 4.12 && < 5 , bytestring , filepath < 1.2.0.1 || >= 1.3- , genvalidity >= 0.8+ , genvalidity >= 1.0 , genvalidity-property >= 0.4 , genvalidity-hspec >= 0.7 , hspec >= 2.0 && < 3
src/Path/Include.hs view
@@ -18,12 +18,14 @@ -- we represent the notion of a relative root by "@.@". The relative root denotes -- the directory which contains the first component of a relative path. -{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE PatternGuards #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-} module Path.PLATFORM_NAME (-- * Types@@ -61,6 +63,8 @@ ,splitExtension ,fileExtension ,replaceExtension+ ,mapSomeBase+ ,prjSomeBase -- * Parsing ,parseAbsDir ,parseRelDir@@ -851,10 +855,27 @@ parseJSON = parseJSONWith parseSomeFile {-# INLINE parseJSON #-} +-- | Helper to project the contents out of a SomeBase object.+--+-- >>> prjSomeBase toFilePath (Abs [absfile|/foo/bar/cow.moo|]) == "/foo/bar/cow.moo"+--+prjSomeBase :: (forall b . Path b t -> a) -> SomeBase t -> a+prjSomeBase f = \case+ Abs a -> f a+ Rel r -> f r++-- | Helper to apply a function to the SomeBase object+--+-- >>> mapSomeBase parent (Abs [absfile|/foo/bar/cow.moo|]) == Abs [absdir|"/foo/bar"|]+--+mapSomeBase :: (forall b . Path b t -> Path b t') -> SomeBase t -> SomeBase t'+mapSomeBase f = \case+ Abs a -> Abs $ f a+ Rel r -> Rel $ f r+ -- | Convert a valid path to a 'FilePath'. fromSomeBase :: SomeBase t -> FilePath-fromSomeBase (Abs p) = toFilePath p-fromSomeBase (Rel p) = toFilePath p+fromSomeBase = prjSomeBase toFilePath -- | Convert a valid directory to a 'FilePath'. fromSomeDir :: SomeBase Dir -> FilePath
test/Path/Gen.hs view
@@ -13,140 +13,107 @@ import qualified System.FilePath as FilePath import Data.GenValidity-import Data.List (isSuffixOf)+import Data.List (isSuffixOf, isInfixOf) import Data.Maybe (isJust, mapMaybe) import Test.QuickCheck --- | An absolute path to a file is valid if:------ * Its path is an absolute path--- * Its path has no trailing path separators--- * Its path is valid according to 'System.FilePath's definition.--- * Its path does not end in '/.'--- * Its path is not '.'--- * Its path does not contain '..'.--- * Parsing the path and rendering it again results in the same path. instance Validity (Path Abs File) where validate p@(Path fp) = mconcat- [ declare "The path is absolute." $ FilePath.isAbsolute fp- , declare "The path has no trailing path separator." $- not (FilePath.hasTrailingPathSeparator fp)- , declare "System.FilePath considers the path valid." $ FilePath.isValid fp- , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)- , declare "The path does not equal \".\"" $ fp /= "."- , declare "The path does not a parent directory." $ not (hasParentDir fp)- , declare "The path can be identically parsed as an absolute file path." $- parseAbsFile fp == Just p+ [ validateCommon p,+ validateAbs p,+ validateFile p,+ declare "The path can be identically parsed as an absolute file path." $+ parseAbsFile fp == Just p ] --- | A relative path to a file is valid if:------ * Its path is a relative path--- * Its path does not have a trailing path separator--- * Its path is valid according to 'System.FilePath's definition.--- * Its path is not '.'--- * Its path is not empty--- * Its path does not end in '/.'--- * Its path is not '.'--- * Its path does not contain '..'.--- * Parsing the path and rendering it again results in the same path. instance Validity (Path Rel File) where validate p@(Path fp) = mconcat- [ declare "The path is relative." $ FilePath.isRelative fp- , declare "The path has no trailing path separator." $- not (FilePath.hasTrailingPathSeparator fp)- , declare "System.FilePath considers the path valid." $ FilePath.isValid fp- , declare "The path does not equal \".\"" $ fp /= "."- , declare "The path is not empty" $ not (null fp)- , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)- , declare "The path does not a parent directory." $ not (hasParentDir fp)- , declare "The path can be identically parsed as a relative file path." $- parseRelFile fp == Just p+ [ validateCommon p,+ validateRel p,+ validateFile p,+ declare "The path can be identically parsed as a relative file path." $+ parseRelFile fp == Just p ] --- | An absolute path to a directory is valid if:------ * Its path is an absolute path--- * Its path has a trailing path separator--- * Its path is valid according to 'System.FilePath's definition.--- * Its path does not contain '..'.--- * Parsing the path and rendering it again results in the same path. instance Validity (Path Abs Dir) where validate p@(Path fp) = mconcat- [ declare "The path is absolute." $ FilePath.isAbsolute fp- , declare "The path has a trailing path separator." $ FilePath.hasTrailingPathSeparator fp- , declare "System.FilePath considers the path valid." $ FilePath.isValid fp- , declare "The path does not a parent directory." $ not (hasParentDir fp)- , declare "The path can be identically parsed as an absolute directory path." $- parseAbsDir fp == Just p+ [ validateCommon p,+ validateAbs p,+ validateDirectory p,+ declare "The path can be identically parsed as an absolute directory path." $+ parseAbsDir fp == Just p ] --- | A relative path to a directory is valid if:------ * Its path is a relative path--- * Its path has a trailing path separator--- * Its path is valid according to 'System.FilePath's definition.--- * Its path does not contain '..'.--- * Parsing the path and rendering it again results in the same path. instance Validity (Path Rel Dir) where- validate (Path "") = valid validate p@(Path fp) = mconcat- [ declare "The path is relative." $ FilePath.isRelative fp- , declare "The path has a trailing path separator." $ FilePath.hasTrailingPathSeparator fp- , declare "System.FilePath considers the path valid." $ FilePath.isValid fp- , declare "The path is not empty." $ not (null fp)- , declare "The path does not a parent directory." $ not (hasParentDir fp)- , declare "The path can be identically parsed as a relative directory path." $- parseRelDir fp == Just p+ [ validateCommon p,+ validateRel p,+ validateDirectory p,+ declare "The path can be identically parsed as a relative directory path if it's not empty." $+ parseRelDir fp == Just p || fp == "" ] -instance GenUnchecked (Path Abs File) where- genUnchecked = Path <$> genFilePath+instance Validity (SomeBase Dir) -instance GenValid (Path Abs File) where- shrinkValid = shrinkValidWith parseAbsFile+instance Validity (SomeBase File) -instance GenUnchecked (Path Rel File) where- genUnchecked = Path <$> genFilePath+validateCommon :: Path b t -> Validation+validateCommon (Path fp) = mconcat+ [ declare "System.FilePath considers the path valid if it's not empty." $ FilePath.isValid fp || fp == ""+ , declare "The path does not contain a '..' path component." $ not (hasParentDir fp)+ ] -instance GenValid (Path Rel File) where- shrinkValid = shrinkValidWith parseRelFile+validateDirectory :: Path b Dir -> Validation+validateDirectory (Path fp) = mconcat+ [ declare "The path has a trailing path separator if it's not empty." $ FilePath.hasTrailingPathSeparator fp || fp == ""+ ] -instance GenUnchecked (Path Abs Dir) where- genUnchecked = Path <$> genFilePath+validateFile :: Path b File -> Validation+validateFile (Path fp) = mconcat+ [ declare "The path has no trailing path separator." $ not (FilePath.hasTrailingPathSeparator fp)+ , declare "The path does not equal \".\"" $ fp /= "."+ , declare "The path does not end in /." $ not ("/." `isSuffixOf` fp)+ ] -instance GenValid (Path Abs Dir) where- shrinkValid = shrinkValidWith parseAbsDir+validateAbs :: Path Abs t -> Validation+validateAbs (Path fp) = mconcat+ [ declare "The path is absolute." $ FilePath.isAbsolute fp+ ] -instance GenUnchecked (Path Rel Dir) where- genUnchecked = Path <$> genFilePath+validateRel :: Path Rel t -> Validation+validateRel (Path fp) = mconcat+ [ declare "The path is relative." $ FilePath.isRelative fp+ ] -instance GenValid (Path Rel Dir) where- shrinkValid = shrinkValidWith parseRelDir+instance GenValid (Path Abs File) where+ genValid = (Path . ('/' :) <$> genFilePath) `suchThat` isValid+ shrinkValid = filter isValid . shrinkValidWith parseAbsFile -data Extension =- Extension String- deriving (Show)+instance GenValid (Path Abs Dir) where+ genValid = (Path . ('/' :) . (++ "/") <$> genFilePath) `suchThat` isValid+ shrinkValid = filter isValid . shrinkValidWith parseAbsDir -instance Validity Extension where- validate (Extension ext) =- mconcat- [ delve "Extension" ext- , declare "It is possible to add the extension to \"./\"" $- isJust $ addExtension ext $(mkRelFile "x")- ]+instance GenValid (Path Rel File) where+ genValid = (Path <$> genFilePath) `suchThat` isValid+ shrinkValid = filter isValid . shrinkValidWith parseRelFile -instance GenUnchecked Extension where- genUnchecked = Extension <$> genFilePath- shrinkUnchecked (Extension e) = Extension <$> shrinkUnchecked e+instance GenValid (Path Rel Dir) where+ genValid = (Path . (++ "/") <$> genFilePath) `suchThat` isValid+ shrinkValid = filter isValid . shrinkValidWith parseRelDir -instance GenValid Extension+instance GenValid (SomeBase Dir) where+ genValid = genValidStructurallyWithoutExtraChecking+ shrinkValid = shrinkValidStructurallyWithoutExtraFiltering +instance GenValid (SomeBase File) where+ genValid = genValidStructurallyWithoutExtraChecking+ shrinkValid = shrinkValidStructurallyWithoutExtraFiltering+ -- | Generates 'FilePath's with a high occurence of @'.'@, @'\/'@ and -- @'\\'@ characters. The resulting 'FilePath's are not guaranteed to -- be valid.@@ -157,8 +124,4 @@ genPathyChar = frequency [(2, choose (minBound, maxBound)), (1, elements "./\\")] shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b]-shrinkValidWith fun (Path f) = filter (/= (Path f)) . mapMaybe fun $ shrinkUnchecked f--shrinkValidExtension :: Extension -> [Extension]-shrinkValidExtension (Extension s) =- map (Extension . drop 1 . toFilePath) $ mapMaybe (flip addExtension $(mkRelFile "x")) (shrink s)+shrinkValidWith fun (Path f) = filter (/= (Path f)) . mapMaybe fun $ shrinkValid f
test/ValidityTest.hs view
@@ -34,11 +34,17 @@ shrinkValidSpec @(Path Abs Dir) genValidSpec @(Path Rel Dir) shrinkValidSpec @(Path Rel Dir)+ genValidSpec @(SomeBase Dir)+ shrinkValidSpec @(SomeBase Dir)+ genValidSpec @(SomeBase File)+ shrinkValidSpec @(SomeBase File) describe "Parsing" $ do describe "Path Abs Dir" (parserSpec parseAbsDir) describe "Path Rel Dir" (parserSpec parseRelDir) describe "Path Abs File" (parserSpec parseAbsFile) describe "Path Rel File" (parserSpec parseRelFile)+ describe "SomeBase Dir" (parserSpec parseSomeDir)+ describe "SomeBase file" (parserSpec parseSomeFile) describe "Operations" $ do describe "(</>)" operationAppend describe "stripProperPrefix" operationStripDir@@ -51,30 +57,49 @@ -- | The 'filename' operation. operationFilename :: Spec operationFilename = do- forAllDirs "filename parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \parent ->+ forAllDirs "filename (parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \parent -> forAllValid $ \file -> filename (parent </> file) `shouldBe` filename file+ forSomeDirs "filename (some:parent </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $ \someParent ->+ forAllValid $ \file ->+ prjSomeBase filename (mapSomeBase (</> file) someParent) `shouldBe` filename file it "produces a valid path on when passed a valid absolute path" $ do- producesValidsOnValids (filename :: Path Abs File -> Path Rel File)+ producesValid (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)+ producesValid (filename :: Path Rel File -> Path Rel File)+ it "produces a valid filename when passed some valid base path" $+ producesValid (prjSomeBase filename :: SomeBase File -> Path Rel File) -- | The 'dirname' operation. operationDirname :: Spec operationDirname = do forAllDirs "dirname parent </> $(mkRelDir dirname)) == dirname $(mkRelDir dirname)" $ \parent -> forAllValid $ \dir -> if dir == Path [] then pure () else dirname (parent </> dir) `shouldBe` dirname dir+ forSomeDirs "dirname (some:parent </> $(mkRelDir dirname)) == dirname $(mkRelDir dirname)" $ \someParent ->+ forAllValid $ \dir -> if dir == Path []+ then pure ()+ else prjSomeBase dirname (mapSomeBase (</> dir) someParent) `shouldBe` dirname dir it "produces a valid path on when passed a valid absolute path" $ do- producesValidsOnValids (dirname :: Path Abs Dir -> Path Rel Dir)+ producesValid (dirname :: Path Abs Dir -> Path Rel Dir) it "produces a valid path on when passed a valid relative path" $ do- producesValidsOnValids (dirname :: Path Rel Dir -> Path Rel Dir)+ producesValid (dirname :: Path Rel Dir -> Path Rel Dir)+ it "produces a valid path when passed some valid longer path" $+ producesValid (prjSomeBase dirname :: SomeBase Dir -> Path Rel Dir) -- | The 'parent' operation. operationParent :: Spec operationParent = do it "produces a valid path on when passed a valid file path" $ do- producesValidsOnValids (parent :: Path Abs File -> Path Abs Dir)+ producesValid (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)+ producesValid (parent :: Path Abs Dir -> Path Abs Dir)+ it "produces a valid path on when passed a valid abs file path" $ do+ producesValid (parent :: Path Abs File -> Path Abs Dir)+ it "produces a valid path on when passed a valid rel file path" $ do+ producesValid (parent :: Path Rel File -> Path Rel Dir)+ it "produces a valid path on when passed a valid abs directory path" $ do+ producesValid (parent :: Path Abs Dir -> Path Abs Dir)+ it "produces a valid path on when passed a valid rel directory path" $ do+ producesValid (parent :: Path Rel Dir -> Path Rel Dir) -- | The 'isProperPrefixOf' operation. operationIsParentOf :: Spec@@ -92,42 +117,49 @@ then pure () -- TODO do we always need this condition? else stripProperPrefix parent (parent </> child) `shouldBe` Just child it "produces a valid path on when passed a valid absolute file paths" $ do- producesValidsOnValids2+ producesValid2 (stripProperPrefix :: 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+ producesValid2 (stripProperPrefix :: 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+ producesValid2 (stripProperPrefix :: 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+ producesValid2 (stripProperPrefix :: Path Rel Dir -> Path Rel Dir -> Maybe (Path Rel Dir)) -- | The '</>' operation. operationAppend :: Spec operationAppend = do it "produces a valid path on when creating valid absolute file paths" $ do- producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel File -> Path Abs File)+ producesValid2 ((</>) :: 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)+ producesValid2 ((</>) :: 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)+ producesValid2 ((</>) :: 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)+ producesValid2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir) extensionsSpec :: Spec extensionsSpec = do+ let addExtGensValidFile p =+ case addExtension p $(mkRelFile "x") of+ Nothing -> True+ Just _ ->+ case parseRelFile p of+ Nothing -> False+ _ -> True it "if addExtension a b succeeds then parseRelFile b succeeds - 1" $ forAll genFilePath addExtGensValidFile- -- skew the generated path towards a valid extension by prefixing a "."+ -- skew the generated path towards a valid extension by prefixing a "." it "if addExtension a b succeeds then parseRelFile b succeeds - 2" $ forAll genFilePath $ addExtGensValidFile . ("." ++)- forAllFiles- "(toFilePath . fromJust . addExtension ext) file \- \== toFilePath a ++ b" $ \file ->- forAllValid $ \(Extension ext) ->- (toFilePath . fromJust . addExtension ext) file `shouldBe` toFilePath file ++ ext+ forAllFiles "Adding an extension is like adding the extension to the end if it succeeds" $ \file ->+ forAllValid $ \ext ->+ case addExtension ext file of+ Nothing -> pure () -- Fine+ Just p -> toFilePath p `shouldBe` toFilePath file ++ ext forAllFiles "splitExtension output joins to result in the original file" $ \file -> case splitExtension file of Nothing -> pure ()@@ -149,28 +181,24 @@ case splitExtension file of Nothing -> pure () Just (f, ext) -> addExtension ext f `shouldBe` Just file- forAllFiles "uncurry addExtension . swap >=> splitExtension == return" $ \file ->- forAllValid $ \(Extension ext) ->- (addExtension ext file >>= splitExtension) `shouldReturn` (file, ext)+ forAllFiles "an extension that was added can be split off again" $ \file ->+ forAllValid $ \ext ->+ case addExtension ext file of+ Nothing -> pure () -- Fine+ Just p -> splitExtension p `shouldBe` Just (file, ext) forAllFiles "fileExtension == (fmap snd) . splitExtension" $ \file -> case splitExtension file of Nothing -> pure () Just (_, ext) -> fileExtension file `shouldBe` Just ext- forAllFiles "flip addExtension file >=> fileExtension == return" $ \file ->- forAllValid $ \(Extension ext) ->- (fileExtension . fromJust . addExtension ext) file `shouldReturn` ext+ forAllFiles "an extension that was added is considered to be there" $ \file ->+ forAllValid $ \ext ->+ case addExtension ext file of+ Nothing -> pure () -- Fine+ Just p -> fileExtension p `shouldBe` Just ext forAllFiles "(fileExtension >=> flip replaceExtension file) file == return file" $ \file -> case fileExtension file of Nothing -> pure () Just ext -> replaceExtension ext file `shouldBe` Just file- where- addExtGensValidFile p =- case addExtension p $(mkRelFile "x") of- Nothing -> True- Just _ ->- case parseRelFile p of- Nothing -> False- _ -> True forAllFiles :: Testable a => String -> (forall b. Path b File -> a) -> Spec forAllFiles n func = do@@ -182,6 +210,10 @@ it (unwords [n, "Path Abs Dir"]) $ forAllValid $ \(parent :: Path Abs Dir) -> func parent it (unwords [n, "Path Rel Dir"]) $ forAllValid $ \(parent :: Path Rel Dir) -> func parent +forSomeDirs :: Testable a => String -> (SomeBase Dir -> a) -> Spec+forSomeDirs n func = do+ it (unwords [n, "SomeBase Dir"]) $ forAllValid $ \(parent :: SomeBase Dir) -> func parent+ forAllParentsAndChildren :: Testable a => String -> (forall b t. Path b Dir -> Path Rel t -> a) -> Spec forAllParentsAndChildren n func = do@@ -208,7 +240,7 @@ parserSpec :: (Show p, Validity p) => (FilePath -> Maybe p) -> Spec parserSpec parser = it "Produces valid paths when it succeeds" $- forAllShrink genFilePath shrinkUnchecked $ \path ->+ forAllShrink genFilePath shrinkValid $ \path -> case parser path of Nothing -> pure () Just p ->