path 0.5.13 → 0.6.0
raw patch · 8 files changed
+345/−174 lines, 8 filesdep +genvalidity-propertydep −genvalidity-hspecdep ~basedep ~exceptionsdep ~hashablenew-uploader
Dependencies added: genvalidity-property
Dependencies removed: genvalidity-hspec
Dependency ranges changed: base, exceptions, hashable
Files
- CHANGELOG +17/−0
- path.cabal +5/−12
- src/Path.hs +128/−64
- src/Path/Internal.hs +23/−4
- test/Path/Gen.hs +8/−5
- test/Posix.hs +62/−27
- test/ValidityTest.hs +35/−34
- test/Windows.hs +67/−28
CHANGELOG view
@@ -1,3 +1,20 @@+0.6.0:++ * Deprecate PathParseException and rename it to PathException+ * Allow 'parent' to work on relative paths as well+ * Deprecate isParentOf and stripDir and rename them to isProperPrefixOf and+ stripProperPrefix respectively.+ * Allow "." as a valid relative dir path with the following rules:+ * "./" </> "./" = "./"+ * "./" </> "x/" = "x/"+ * "x/" </> "./" = "x/"+ * dirname "x" = "./"+ * dirname "/" = "./"+ * dirname "./" = "./"+ * Make dirname return "." instead of "/" (fixes #18).+ * Remove the 'validity' flag.+ * Add synonym for setFileExtension in the form of an operator: (-<.>).+ 0.5.13: * Add QuasiQuoters absdir, reldir, absfile, relfile 0.5.11:
path.cabal view
@@ -1,5 +1,5 @@ name: path-version: 0.5.13+version: 0.6.0 synopsis: Support for well-typed paths description: Support for well-typed paths. license: BSD3@@ -10,13 +10,9 @@ category: System, Filesystem build-type: Simple cabal-version: >=1.10+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 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@@ -46,20 +42,17 @@ default-language: Haskell2010 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: QuickCheck+ build-depends: QuickCheck , aeson- , base >= 4.9 && < 5+ , base >= 4.7 && < 5 , bytestring , filepath < 1.2.0.1 || >= 1.3 , genvalidity >= 0.3 && < 0.4- , genvalidity-hspec >= 0.3 && < 0.4+ , genvalidity-property >= 0.0 && < 0.1 , hspec >= 2.0 && < 3 , mtl >= 2.0 && < 3 , path
src/Path.hs view
@@ -1,4 +1,15 @@--- | Support for well-typed paths.+-- | This library provides a well-typed representation of paths in a filesystem+-- directory tree. A path is represented by a number of path components+-- separated by a path separator which is a @/@ on POSIX systems and can be a+-- @/@ or @\\@ on Windows.+--+-- The root of the tree is represented by a @/@ on POSIX and a drive letter+-- followed by a @/@ or @\\@ on Windows (e.g. @C:\\@). Paths can be absolute+-- or relative. An absolute path always starts from the root of the tree (e.g.+-- @\/x/y@) whereas a relative path never starts with the root (e.g. @x/y@).+-- Just like we represent the notion of an absolute root by "@/@", the same way+-- 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 CPP #-} {-# LANGUAGE TemplateHaskell #-}@@ -14,6 +25,8 @@ ,Rel ,File ,Dir+ -- * Exceptions+ ,PathException(..) -- * QuasiQuoters -- | Using the following requires the QuasiQuotes language extension. --@@ -30,19 +43,19 @@ ,relfile -- * Operations ,(</>)- ,stripDir- ,isParentOf+ ,stripProperPrefix+ ,isProperPrefixOf ,parent ,filename ,dirname ,fileExtension ,setFileExtension+ ,(-<.>) -- * Parsing ,parseAbsDir ,parseRelDir ,parseAbsFile ,parseRelFile- ,PathParseException -- * Conversion ,toFilePath ,fromAbsDir@@ -55,6 +68,10 @@ ,mkRelDir ,mkAbsFile ,mkRelFile+ -- * Deprecated+ ,PathParseException+ ,stripDir+ ,isParentOf ) where @@ -77,10 +94,8 @@ -- | An absolute path. data Abs deriving (Typeable) --- | A relative path; one without a root. Note that a @.@ as well as any path--- starting with a @..@ is not a valid relative path. In other words, a--- relative path is always strictly under the directory tree to which it is--- relative.+-- | A relative path; one without a root. Note that a @..@ path component to+-- represent the parent directory is not allowed by this library. data Rel deriving (Typeable) -- | A file path.@@ -114,16 +129,17 @@ Left e -> fail (show e) {-# INLINE parseJSONWith #-} --- | Exception when parsing a location.-data PathParseException+-- | Exceptions that can occur during path operations.+--+-- @since 0.6.0+data PathException = InvalidAbsDir FilePath | InvalidRelDir FilePath | InvalidAbsFile FilePath | InvalidRelFile FilePath- | Couldn'tStripPrefixDir FilePath FilePath+ | NotAProperPrefix FilePath FilePath deriving (Show,Typeable)-instance Exception PathParseException-+instance Exception PathException -------------------------------------------------------------------------------- -- QuasiQuoters@@ -215,58 +231,75 @@ -- -- @x \<\/> $(mkAbsDir …)@ --+infixr 5 </> (</>) :: Path b Dir -> Path Rel t -> Path b t (</>) (Path a) (Path b) = Path (a ++ b) --- | Strip directory from path, making it relative to that directory.--- Throws 'Couldn'tStripPrefixDir' if directory is not a parent of the path.+-- | If the directory in the first argument is a proper prefix of the path in+-- the second argument strip it from the second argument, generating a path+-- relative to the directory.+-- Throws 'NotAProperPrefix' if the directory is not a proper prefix of the+-- path. -- -- The following properties hold: ----- @stripDir x (x \<\/> y) = y@+-- @stripProperPrefix x (x \<\/> y) = y@ -- -- Cases which are proven not possible: ----- @stripDir (a :: Path Abs …) (b :: Path Rel …)@+-- @stripProperPrefix (a :: Path Abs …) (b :: Path Rel …)@ ----- @stripDir (a :: Path Rel …) (b :: Path Abs …)@+-- @stripProperPrefix (a :: Path Rel …) (b :: Path Abs …)@ -- -- In other words the bases must match. ---stripDir :: MonadThrow m+-- @since 0.6.0+stripProperPrefix :: MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t)-stripDir (Path p) (Path l) =+stripProperPrefix (Path p) (Path l) = case stripPrefix p l of- Nothing -> throwM (Couldn'tStripPrefixDir p l)- Just "" -> throwM (Couldn'tStripPrefixDir p l)+ Nothing -> throwM (NotAProperPrefix p l)+ Just "" -> throwM (NotAProperPrefix p l) Just ok -> return (Path ok) --- | Is p a parent of the given location? Implemented in terms of--- 'stripDir'. The bases must match.+-- | Determines if the path in the first parameter is a proper prefix of the+-- path in the second parameter. -- -- The following properties hold: ----- @not (x \`isParentOf\` x)@+-- @not (x \`isProperPrefixOf\` x)@ ----- @x \`isParentOf\` (x \<\/\> y)@+-- @x \`isProperPrefixOf\` (x \<\/\> y)@ ---isParentOf :: Path b Dir -> Path b t -> Bool-isParentOf p l =- isJust (stripDir p l)+-- @since 0.6.0+isProperPrefixOf :: Path b Dir -> Path b t -> Bool+isProperPrefixOf p l = isJust (stripProperPrefix p l) --- | Take the absolute parent directory from the absolute path.+-- | Take the parent path component from a path. -- -- The following properties hold: ----- @parent (x \<\/> y) == x@+-- @+-- parent (x \<\/> y) == x+-- parent \"\/x\" == \"\/\"+-- parent \"x\" == \".\"+-- @ ----- On the root, getting the parent is idempotent:+-- On the root (absolute or relative), getting the parent is idempotent: ----- @parent (parent \"\/\") = \"\/\"@+-- @+-- parent \"\/\" = \"\/\"+-- parent \"\.\" = \"\.\"+-- @ ---parent :: Path Abs t -> Path Abs Dir+parent :: Path b t -> Path b Dir+parent (Path "") = Path ""+parent (Path fp) | FilePath.isDrive fp = Path fp parent (Path fp) =- Path (normalizeDir (FilePath.takeDirectory (FilePath.dropTrailingPathSeparator fp)))+ Path+ $ normalizeDir+ $ FilePath.takeDirectory+ $ FilePath.dropTrailingPathSeparator fp -- | Extract the file part of a path. --@@ -282,11 +315,14 @@ -- -- The following properties hold: --+-- @dirname $(mkRelDir ".") == $(mkRelDir ".")@+-- -- @dirname (p \<\/> a) == dirname a@ -- dirname :: Path b Dir -> Path Rel Dir-dirname (Path l) =- Path (last (FilePath.splitPath l))+dirname (Path "") = Path ""+dirname (Path l) | FilePath.isDrive l = Path ""+dirname (Path l) = Path (last (FilePath.splitPath l)) -- | Get extension from given file path. --@@ -309,16 +345,25 @@ where coercePath :: Path a b -> Path a' b' coercePath (Path a) = Path a +-- | A synonym for 'setFileExtension' in the form of an operator.+--+-- @since 0.6.0+infixr 7 -<.>+(-<.>) :: MonadThrow m+ => Path b File -- ^ Old file name+ -> String -- ^ Extension to set+ -> m (Path b File) -- ^ New file name with the desired extension+(-<.>) = flip setFileExtension -------------------------------------------------------------------------------- -- Parsers -- | Convert an absolute 'FilePath' to a normalized absolute dir 'Path'. ----- Throws: 'PathParseException' when the supplied path:+-- Throws: 'InvalidAbsDir' when the supplied path: -- -- * is not an absolute path--- * contains a @..@ anywhere in the path+-- * contains a @..@ path component representing the parent directory -- * is not a valid path (See 'System.FilePath.isValid') -- parseAbsDir :: MonadThrow m@@ -332,11 +377,11 @@ -- | Convert a relative 'FilePath' to a normalized relative dir 'Path'. ----- Throws: 'PathParseException' when the supplied path:+-- Throws: 'InvalidRelDir' when the supplied path: -- -- * is not a relative path--- * is any of @""@, @.@ or @..@--- * contains @..@ anywhere in the path+-- * is @""@+-- * contains a @..@ path component representing the parent directory -- * is not a valid path (See 'System.FilePath.isValid') -- parseRelDir :: MonadThrow m@@ -345,20 +390,21 @@ if not (FilePath.isAbsolute filepath) && not (hasParentDir filepath) && not (null filepath) &&- filepath /= "." &&- normalizeFilePath filepath /= curDirNormalizedFP && FilePath.isValid filepath then return (Path (normalizeDir filepath)) else throwM (InvalidRelDir filepath) -- | Convert an absolute 'FilePath' to a normalized absolute file 'Path'. ----- Throws: 'PathParseException' when the supplied path:+-- Throws: 'InvalidAbsFile' when the supplied path: -- -- * is not an absolute path--- * has a trailing path separator--- * contains @..@ anywhere in the path--- * ends in @/.@+-- * is a directory path i.e.+--+-- * has a trailing path separator+-- * is @.@ or ends in @/.@+--+-- * contains a @..@ path component representing the parent directory -- * is not a valid path (See 'System.FilePath.isValid') -- parseAbsFile :: MonadThrow m@@ -381,12 +427,16 @@ -- | Convert a relative 'FilePath' to a normalized relative file 'Path'. ----- Throws: 'PathParseException' when the supplied path:+-- Throws: 'InvalidRelFile' when the supplied path: -- -- * is not a relative path--- * has a trailing path separator--- * is @""@, @.@ or @..@--- * contains @..@ anywhere in the path+-- * is @""@+-- * is a directory path i.e.+--+-- * has a trailing path separator+-- * is @.@ or ends in @/.@+--+-- * contains a @..@ path component representing the parent directory -- * is not a valid path (See 'System.FilePath.isValid') -- parseRelFile :: MonadThrow m@@ -410,14 +460,6 @@ -------------------------------------------------------------------------------- -- Conversion --- | Convert to a 'FilePath' type.------ All directories have a trailing slash, so if you want no trailing--- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from--- the filepath package.-toFilePath :: Path b t -> FilePath-toFilePath (Path l) = l- -- | Convert absolute path to directory to 'FilePath' type. fromAbsDir :: Path Abs Dir -> FilePath fromAbsDir = toFilePath@@ -481,12 +523,17 @@ -------------------------------------------------------------------------------- -- Internal functions -curDirNormalizedFP :: FilePath-curDirNormalizedFP = '.' : [FilePath.pathSeparator]- -- | Internal use for normalizing a directory. normalizeDir :: FilePath -> FilePath-normalizeDir = FilePath.addTrailingPathSeparator . normalizeFilePath+normalizeDir =+ normalizeRelDir+ . FilePath.addTrailingPathSeparator+ . normalizeFilePath+ where+ -- Represent a "." in relative dir path as "" internally so that it+ -- composes without having to renormalize the path.+ normalizeRelDir p | p == relRootFP = ""+ normalizeRelDir p = p normalizeFilePath :: FilePath -> FilePath #if defined(mingw32_HOST_OS) || defined(__MINGW32__) || MIN_VERSION_filepath(1,4,0)@@ -500,3 +547,20 @@ normalizeLeadingSeparators x = x #endif +--------------------------------------------------------------------------------+-- Deprecated++{-# DEPRECATED PathParseException "Please use PathException instead." #-}+-- | Same as 'PathException'.+type PathParseException = PathException++{-# DEPRECATED stripDir "Please use stripProperPrefix instead." #-}+-- | Same as 'stripProperPrefix'.+stripDir :: MonadThrow m+ => Path b Dir -> Path b t -> m (Path Rel t)+stripDir = stripProperPrefix++{-# DEPRECATED isParentOf "Please use isProperPrefixOf instead." #-}+-- | Same as 'isProperPrefixOf'.+isParentOf :: Path b Dir -> Path b t -> Bool+isParentOf = isProperPrefixOf
src/Path/Internal.hs view
@@ -6,6 +6,8 @@ module Path.Internal ( Path(..) , hasParentDir+ , relRootFP+ , toFilePath ) where @@ -49,27 +51,44 @@ instance Ord (Path b t) where compare (Path x) (Path y) = compare x y +-- | Normalized file path representation for the relative path root+relRootFP :: FilePath+relRootFP = '.' : [FilePath.pathSeparator]++-- | Convert to a 'FilePath' type.+--+-- All directories have a trailing slash, so if you want no trailing+-- slash, you can use 'System.FilePath.dropTrailingPathSeparator' from+-- the filepath package.+toFilePath :: Path b t -> FilePath+toFilePath (Path []) = relRootFP+toFilePath (Path x) = x+ -- | Same as 'show . Path.toFilePath'. -- -- The following property holds: -- -- @x == y ≡ show x == show y@ instance Show (Path b t) where- show (Path x) = show x+ show = show . toFilePath instance NFData (Path b t) where rnf (Path x) = rnf x instance ToJSON (Path b t) where- toJSON (Path x) = toJSON x+ toJSON = toJSON . toFilePath {-# INLINE toJSON #-} #if MIN_VERSION_aeson(0,10,0)- toEncoding (Path x) = toEncoding x+ toEncoding = toEncoding . toFilePath {-# INLINE toEncoding #-} #endif instance Hashable (Path b t) where- hashWithSalt n (Path path) = hashWithSalt n path+ -- A "." is represented as an empty string ("") internally. Hashing ""+ -- results in a hash that is the same as the salt. To produce a more+ -- reasonable hash we use "toFilePath" before hashing so that a "" gets+ -- converted back to a ".".+ hashWithSalt n path = hashWithSalt n (toFilePath path) -- | 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/Path/Gen.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE FlexibleInstances #-} module Path.Gen where +import Data.Functor+import Prelude+ import Path import Path.Internal @@ -40,14 +43,13 @@ && (parseAbsDir fp == Just p) instance Validity (Path Rel Dir) where- isValid p@(Path fp)- = FilePath.isRelative fp+ isValid p =+ FilePath.isRelative fp && FilePath.hasTrailingPathSeparator fp && FilePath.isValid fp- && not (null fp)- && fp /= "." && not (hasParentDir fp) && (parseRelDir fp == Just p)+ where fp = toFilePath p instance GenUnchecked (Path Abs File) where genUnchecked = Path <$> genFilePath@@ -88,7 +90,8 @@ shrinkValidRelFile = shrinkValidWith parseRelFile shrinkValidRelDir :: Path Rel Dir -> [Path Rel Dir]-shrinkValidRelDir = shrinkValidWith parseRelDir+shrinkValidRelDir (Path []) = []+shrinkValidRelDir p = shrinkValidWith parseRelDir p shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b] shrinkValidWith fun (Path s) = mapMaybe fun $ shrink s
test/Posix.hs view
@@ -23,11 +23,13 @@ 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: toFilePath" operationToFilePath+ describe "Operations: stripProperPrefix" operationStripProperPrefix+ describe "Operations: isProperPrefixOf" operationIsProperPrefixOf describe "Operations: parent" operationParent describe "Operations: filename" operationFilename describe "Operations: dirname" operationDirname+ describe "Operations: setFileExtension" operationSetFileExtension describe "Restrictions" restrictions describe "Aeson Instances" aesonInstances describe "QuasiQuotes" quasiquotes@@ -45,7 +47,6 @@ -- parseFails "../" parseFails ".."- parseFails "." parseFails "/.." parseFails "/foo/../bar/" parseFails "/foo/bar/.."@@ -69,6 +70,10 @@ "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)" (dirname ($(mkRelDir "home/chris/") </> $(mkRelDir "bar")) == dirname $(mkRelDir "bar"))+ it+ "dirname / must be a Rel path"+ ((parseAbsDir $ show $ dirname (fromJust (parseAbsDir "/"))+ :: Maybe (Path Abs Dir)) == Nothing) -- | The 'filename' operation. operationFilename :: Spec@@ -90,45 +95,53 @@ (parent ($(mkAbsDir "/foo") </> $(mkRelDir "bar")) == $(mkAbsDir "/foo"))- it "parent \"\" == \"\""- (parent $(mkAbsDir "/") ==- $(mkAbsDir "/"))- it "parent (parent \"\") == \"\""- (parent (parent $(mkAbsDir "/")) ==- $(mkAbsDir "/"))+ it "parent \"/\" == \"/\""+ (parent $(mkAbsDir "/") == $(mkAbsDir "/"))+ it "parent \"/x\" == \"/\""+ (parent $(mkAbsDir "/x") == $(mkAbsDir "/"))+ it "parent \"x\" == \".\""+ (parent $(mkRelDir "x") == $(mkRelDir "."))+ it "parent \".\" == \".\""+ (parent $(mkRelDir ".") == $(mkRelDir ".")) --- | The 'isParentOf' operation.-operationIsParentOf :: Spec-operationIsParentOf =- do it "isParentOf parent (parent </> child) (unit test)"- (isParentOf+-- | The 'isProperPrefixOf' operation.+operationIsProperPrefixOf :: Spec+operationIsProperPrefixOf =+ do it "isProperPrefixOf parent (parent </> child) (absolute)"+ (isProperPrefixOf $(mkAbsDir "///bar/") ($(mkAbsDir "///bar/") </> $(mkRelFile "bar/foo.txt"))) - it "isParentOf parent (parent </> child) (unit test)"- (isParentOf+ it "isProperPrefixOf parent (parent </> child) (relative)"+ (isProperPrefixOf $(mkRelDir "bar/") ($(mkRelDir "bar/") </> $(mkRelFile "bob/foo.txt"))) --- | The 'stripDir' operation.-operationStripDir :: Spec-operationStripDir =- do it "stripDir parent (parent </> child) = child (unit test)"- (stripDir $(mkAbsDir "///bar/")+ it "not (x `isProperPrefixOf` x)"+ (not (isProperPrefixOf $(mkRelDir "x") $(mkRelDir "x")))++ it "not (/ `isProperPrefixOf` /)"+ (not (isProperPrefixOf $(mkAbsDir "/") $(mkAbsDir "/")))++-- | The 'stripProperPrefix' operation.+operationStripProperPrefix :: Spec+operationStripProperPrefix =+ do it "stripProperPrefix parent (parent </> child) = child (unit test)"+ (stripProperPrefix $(mkAbsDir "///bar/") ($(mkAbsDir "///bar/") </> $(mkRelFile "bar/foo.txt")) == Just $(mkRelFile "bar/foo.txt")) - it "stripDir parent (parent </> child) = child (unit test)"- (stripDir $(mkRelDir "bar/")+ it "stripProperPrefix parent (parent </> child) = child (unit test)"+ (stripProperPrefix $(mkRelDir "bar/") ($(mkRelDir "bar/") </> $(mkRelFile "bob/foo.txt")) == Just $(mkRelFile "bob/foo.txt")) - it "stripDir parent parent = _|_"- (stripDir $(mkAbsDir "/home/chris/foo")+ it "stripProperPrefix parent parent = _|_"+ (stripProperPrefix $(mkAbsDir "/home/chris/foo") $(mkAbsDir "/home/chris/foo") == Nothing) @@ -147,11 +160,33 @@ ($(mkRelDir "home/") </> $(mkRelDir "chris") == $(mkRelDir "home/chris"))+ it ". + . = ."+ ($(mkRelDir "./") </> $(mkRelDir ".") == $(mkRelDir "."))+ it ". + x = x"+ ($(mkRelDir ".") </> $(mkRelDir "x") == $(mkRelDir "x"))+ it "x + . = x"+ ($(mkRelDir "x") </> $(mkRelDir "./") == $(mkRelDir "x")) it "RelDir + RelFile = RelFile" ($(mkRelDir "home/") </> $(mkRelFile "chris/test.txt") == $(mkRelFile "home/chris/test.txt")) +operationToFilePath :: Spec+operationToFilePath =+ do it "toFilePath $(mkRelDir \".\") == \"./\""+ (toFilePath $(mkRelDir ".") == "./")+ it "show $(mkRelDir \".\") == \"\\\"./\\\"\""+ (show $(mkRelDir ".") == "\"./\"")++operationSetFileExtension :: Spec+operationSetFileExtension = do+ it "adds extension if there is none" $+ setFileExtension "txt" $(mkRelFile "foo")+ `shouldReturn` $(mkRelFile "foo.txt")+ it "replaces extension if the input path already has one" $+ setFileExtension "txt" $(mkRelFile "foo.bar")+ `shouldReturn` $(mkRelFile "foo.txt")+ -- | Tests for the tokenizer. parseAbsDirSpec :: Spec parseAbsDirSpec =@@ -175,8 +210,8 @@ failing "//" succeeding "~/" (Path "~/") -- https://github.com/chrisdone/path/issues/19 failing "/"- failing "./"- failing "././"+ succeeding "./" (Path "")+ succeeding "././" (Path "") failing "//" failing "///foo//bar//mu/" failing "///foo//bar////mu"
test/ValidityTest.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -15,7 +14,7 @@ import Path.Internal import Test.Hspec import Test.QuickCheck-import Test.Validity+import Test.Validity.Property import Path.Gen @@ -31,8 +30,8 @@ describe "Parsing: Path Abs File" (parserSpec parseAbsFile) describe "Parsing: Path Rel File" (parserSpec parseRelFile) describe "Operations: (</>)" operationAppend- describe "Operations: stripDir" operationStripDir- describe "Operations: isParentOf" operationIsParentOf+ describe "Operations: stripProperPrefix" operationStripDir+ describe "Operations: isProperPrefixOf" operationIsParentOf describe "Operations: parent" operationParent describe "Operations: filename" operationFilename @@ -50,92 +49,94 @@ filename (parent </> file) `shouldBe` filename file it "produces a valid path on when passed a valid absolute path" $ do- producesValidsOnValids (filename @Abs)+ producesValidsOnValids (filename :: Path Abs File -> Path Rel File) it "produces a valid path on when passed a valid relative path" $ do- producesValidsOnValids (filename @Rel)+ producesValidsOnValids (filename :: Path Rel File -> Path Rel File) -- | The 'parent' operation. operationParent :: Spec operationParent = do it "produces a valid path on when passed a valid file path" $ do- producesValidsOnValids (parent @File)+ producesValidsOnValids (parent :: Path Abs File -> Path Abs Dir) it "produces a valid path on when passed a valid directory path" $ do- producesValidsOnValids (parent @Dir)+ producesValidsOnValids (parent :: Path Abs Dir -> Path Abs Dir) --- | The 'isParentOf' operation.+-- | The 'isProperPrefixOf' operation. operationIsParentOf :: Spec operationIsParentOf = do- it "isParentOf parent (parent </> child)" $+ it "isProperPrefixOf parent (parent </> child)" $ forAllShrink genValid shrinkValidAbsDir $ \parent -> forAllShrink genValid shrinkValidRelFile $ \child ->- isParentOf parent (parent </> child)+ isProperPrefixOf parent (parent </> child) - it "isParentOf parent (parent </> child)" $+ it "isProperPrefixOf parent (parent </> child)" $ forAllShrink genValid shrinkValidAbsDir $ \parent -> forAllShrink genValid shrinkValidRelDir $ \child ->- isParentOf parent (parent </> child)+ child == Path [] || isProperPrefixOf parent (parent </> child) - it "isParentOf parent (parent </> child)" $+ it "isProperPrefixOf parent (parent </> child)" $ forAllShrink genValid shrinkValidRelDir $ \parent -> forAllShrink genValid shrinkValidRelFile $ \child ->- isParentOf parent (parent </> child)+ isProperPrefixOf parent (parent </> child) - it "isParentOf parent (parent </> child)" $+ it "isProperPrefixOf parent (parent </> child)" $ forAllShrink genValid shrinkValidRelDir $ \parent -> forAllShrink genValid shrinkValidRelDir $ \child ->- isParentOf parent (parent </> child)+ child == Path [] || isProperPrefixOf parent (parent </> child) --- | The 'stripDir' operation.+-- | The 'stripProperPrefix' operation. operationStripDir :: Spec operationStripDir = do- it "stripDir parent (parent </> child) = child" $+ it "stripProperPrefix parent (parent </> child) = child" $ forAllShrink genValid shrinkValidAbsDir $ \parent -> forAllShrink genValid shrinkValidRelFile $ \child ->- stripDir parent (parent </> child) == Just child+ stripProperPrefix parent (parent </> child) == Just child - it "stripDir parent (parent </> child) = child" $+ it "stripProperPrefix parent (parent </> child) = child" $ forAllShrink genValid shrinkValidRelDir $ \parent -> forAllShrink genValid shrinkValidRelFile $ \child ->- stripDir parent (parent </> child) == Just child+ stripProperPrefix parent (parent </> child) == Just child - it "stripDir parent (parent </> child) = child" $+ it "stripProperPrefix parent (parent </> child) = child" $ forAllShrink genValid shrinkValidAbsDir $ \parent -> forAllShrink genValid shrinkValidRelDir $ \child ->- stripDir parent (parent </> child) == Just child+ child == Path []+ || stripProperPrefix parent (parent </> child) == Just child - it "stripDir parent (parent </> child) = child" $+ it "stripProperPrefix parent (parent </> child) = child" $ forAllShrink genValid shrinkValidRelDir $ \parent -> forAllShrink genValid shrinkValidRelDir $ \child ->- stripDir parent (parent </> child) == Just child+ child == Path []+ || stripProperPrefix parent (parent </> child) == Just child it "produces a valid path on when passed a valid absolute file paths" $ do- producesValidsOnValids2 (stripDir @Maybe @Abs @File)+ producesValidsOnValids2 (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 (stripDir @Maybe @Abs @Dir)+ producesValidsOnValids2 (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 (stripDir @Maybe @Rel @File)+ producesValidsOnValids2 (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 (stripDir @Maybe @Rel @Dir)+ producesValidsOnValids2 (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 ((</>) @Abs @File)+ producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel File -> Path Abs File) it "produces a valid path on when creating valid absolute directory paths" $ do- producesValidsOnValids2 ((</>) @Abs @Dir)+ producesValidsOnValids2 ((</>) :: Path Abs Dir -> Path Rel Dir -> Path Abs Dir) it "produces a valid path on when creating valid relative file paths" $ do- producesValidsOnValids2 ((</>) @Rel @File)+ producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel File -> Path Rel File) it "produces a valid path on when creating valid relative directory paths" $ do- producesValidsOnValids2 ((</>) @Rel @Dir)+ producesValidsOnValids2 ((</>) :: Path Rel Dir -> Path Rel Dir -> Path Rel Dir) parserSpec :: (Show p, Validity p) => (FilePath -> Maybe p) -> Spec parserSpec parser =
test/Windows.hs view
@@ -23,11 +23,13 @@ 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: toFilePath" operationToFilePath+ describe "Operations: stripProperPrefix" operationStripProperPrefix+ describe "Operations: isProperPrefixOf" operationIsProperPrefixOf describe "Operations: parent" operationParent describe "Operations: filename" operationFilename describe "Operations: dirname" operationDirname+ describe "Operations: setFileExtension" operationSetFileExtension describe "Restrictions" restrictions describe "Aeson Instances" aesonInstances describe "QuasiQuotes" quasiquotes@@ -37,7 +39,6 @@ restrictions = do parseFails "..\\" parseFails ".."- parseFails "." parseSucceeds "a.." (Path "a..\\") parseSucceeds "..a" (Path "..a\\") parseFails "\\.."@@ -63,6 +64,13 @@ "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)" (dirname ($(mkRelDir "home\\chris\\") </> $(mkRelDir "bar")) == dirname $(mkRelDir "bar"))+ it+ "dirname $(mkRelDir .) == $(mkRelDir .)"+ (dirname $(mkRelDir ".") == $(mkRelDir "."))+ it+ "dirname C:\\ must be a Rel path"+ ((parseAbsDir $ show $ dirname (fromJust (parseAbsDir "C:\\"))+ :: Maybe (Path Abs Dir)) == Nothing) -- | The 'filename' operation. operationFilename :: Spec@@ -84,45 +92,54 @@ (parent ($(mkAbsDir "C:\\foo") </> $(mkRelDir "bar")) == $(mkAbsDir "C:\\foo"))- it "parent \"\" == \"\""- (parent $(mkAbsDir "C:\\") ==- $(mkAbsDir "C:\\"))- it "parent (parent \"\") == \"\""- (parent (parent $(mkAbsDir "C:\\")) ==- $(mkAbsDir "C:\\"))+ it "parent \"C:\\\" == \"C:\\\""+ (parent $(mkAbsDir "C:\\") == $(mkAbsDir "C:\\"))+ it "parent \"C:\\x\" == \"C:\\\""+ (parent $(mkAbsDir "C:\\x") == $(mkAbsDir "C:\\"))+ it "parent \"x\" == \".\""+ (parent $(mkRelDir "x") == $(mkRelDir "."))+ it "parent \".\" == \".\""+ (parent $(mkRelDir ".") == $(mkRelDir ".")) --- | The 'isParentOf' operation.-operationIsParentOf :: Spec-operationIsParentOf =- do it "isParentOf parent (parent </> child) (unit test)"- (isParentOf+-- | The 'isProperPrefixOf' operation.+operationIsProperPrefixOf :: Spec+operationIsProperPrefixOf =+ do it "isProperPrefixOf parent (parent </> child) (absolute)"+ (isProperPrefixOf $(mkAbsDir "C:\\\\\\bar\\") ($(mkAbsDir "C:\\\\\\bar\\") </> $(mkRelFile "bar\\foo.txt"))) - it "isParentOf parent (parent </> child) (unit test)"- (isParentOf+ it "isProperPrefixOf parent (parent </> child) (relative)"+ (isProperPrefixOf $(mkRelDir "bar\\") ($(mkRelDir "bar\\") </> $(mkRelFile "bob\\foo.txt"))) --- | The 'stripDir' operation.-operationStripDir :: Spec-operationStripDir =- do it "stripDir parent (parent </> child) = child (unit test)"- (stripDir $(mkAbsDir "C:\\\\\\bar\\")+ it "not (x `isProperPrefixOf` x)"+ (not (isProperPrefixOf $(mkRelDir "x") $(mkRelDir "x")))++ it "not (\\ `isProperPrefixOf` \\)"+ (not (isProperPrefixOf $(mkAbsDir "C:\\") $(mkAbsDir "C:\\")))+++-- | The 'stripProperPrefix' operation.+operationStripProperPrefix :: Spec+operationStripProperPrefix =+ do it "stripProperPrefix parent (parent </> child) = child (unit test)"+ (stripProperPrefix $(mkAbsDir "C:\\\\\\bar\\") ($(mkAbsDir "C:\\\\\\bar\\") </> $(mkRelFile "bar\\foo.txt")) == Just $(mkRelFile "bar\\foo.txt")) - it "stripDir parent (parent </> child) = child (unit test)"- (stripDir $(mkRelDir "bar\\")+ it "stripProperPrefix parent (parent </> child) = child (unit test)"+ (stripProperPrefix $(mkRelDir "bar\\") ($(mkRelDir "bar\\") </> $(mkRelFile "bob\\foo.txt")) == Just $(mkRelFile "bob\\foo.txt")) - it "stripDir parent parent = _|_"- (stripDir $(mkAbsDir "C:\\home\\chris\\foo")+ it "stripProperPrefix parent parent = _|_"+ (stripProperPrefix $(mkAbsDir "C:\\home\\chris\\foo") $(mkAbsDir "C:\\home\\chris\\foo") == Nothing) @@ -141,11 +158,33 @@ ($(mkRelDir "home\\") </> $(mkRelDir "chris") == $(mkRelDir "home\\chris"))+ it ". + . = ."+ ($(mkRelDir ".\\") </> $(mkRelDir ".") == $(mkRelDir "."))+ it ". + x = x"+ ($(mkRelDir ".") </> $(mkRelDir "x") == $(mkRelDir "x"))+ it "x + . = x"+ ($(mkRelDir "x") </> $(mkRelDir ".\\") == $(mkRelDir "x")) it "RelDir + RelFile = RelFile" ($(mkRelDir "home\\") </> $(mkRelFile "chris\\test.txt") == $(mkRelFile "home\\chris\\test.txt")) +operationToFilePath :: Spec+operationToFilePath =+ do it "toFilePath $(mkRelDir \".\") == \"./\""+ (toFilePath $(mkRelDir ".") == ".\\")+ it "show $(mkRelDir \".\") == \"\\\".\\\\\"\""+ (show $(mkRelDir ".") == "\".\\\\\"")++operationSetFileExtension :: Spec+operationSetFileExtension = do+ it "adds extension if there is none" $+ setFileExtension "txt" $(mkRelFile "foo")+ `shouldReturn` $(mkRelFile "foo.txt")+ it "replaces extension if the input path already has one" $+ setFileExtension "txt" $(mkRelFile "foo.bar")+ `shouldReturn` $(mkRelFile "foo.txt")+ -- | Tests for the tokenizer. parseAbsDirSpec :: Spec parseAbsDirSpec =@@ -169,8 +208,8 @@ -- failing "//" FIXME -- succeeding "~/" (Path "~/") -- https://github.com/chrisdone/path/issues/19 -- failing "\\" FIXME- failing ".\\"- failing ".\\.\\"+ succeeding ".\\" (Path "")+ succeeding ".\\.\\" (Path "") failing "\\\\" failing "\\\\\\foo\\\\bar\\\\mu\\" failing "\\\\\\foo\\\\bar\\\\\\\\mu"@@ -281,5 +320,5 @@ ([absfile|C:\chris\foo.txt|] `shouldBe` $(mkAbsFile "C:\\chris\\foo.txt")) it "[relfile|foo.exe|] == $(mkRelFile \"foo.exe\")" ([relfile|foo.exe|] `shouldBe` $(mkRelFile "foo.exe"))- it "[relfile|chris\foo.txt|] == $(mkRelFile \"chris\\foo.txt\")"+ it "[relfile|chris\\foo.txt|] == $(mkRelFile \"chris\\foo.txt\")" ([relfile|chris\foo.txt|] `shouldBe` $(mkRelFile "chris\\foo.txt"))