Hello community, here is the log from the commit of package ghc-path for openSUSE:Factory checked in at 2018-05-30 12:11:24 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-path (Old) and /work/SRC/openSUSE:Factory/.ghc-path.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-path" Wed May 30 12:11:24 2018 rev:12 rq:607852 version:0.6.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-path/ghc-path.changes 2017-09-15 22:03:24.359338423 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-path.new/ghc-path.changes 2018-05-30 12:26:40.615578284 +0200 @@ -1,0 +2,21 @@ +Mon May 14 17:02:11 UTC 2018 - [email protected] + +- Update path to version 0.6.1 revision 1. + * Add 'addFileExtension' function and its operator form: (<.>). + * Derive 'Eq' instance for 'PathException'. + * 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: (-<.>). + +------------------------------------------------------------------- Old: ---- path-0.5.13.tar.gz New: ---- path-0.6.1.tar.gz path.cabal ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-path.spec ++++++ --- /var/tmp/diff_new_pack.RQGJuR/_old 2018-05-30 12:26:41.295555078 +0200 +++ /var/tmp/diff_new_pack.RQGJuR/_new 2018-05-30 12:26:41.299554941 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-path # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,13 +19,14 @@ %global pkg_name path %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.5.13 +Version: 0.6.1 Release: 0 Summary: Support for well-typed paths License: BSD-3-Clause Group: Development/Libraries/Haskell URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-aeson-devel BuildRequires: ghc-deepseq-devel @@ -35,9 +36,13 @@ BuildRequires: ghc-rpm-macros BuildRequires: ghc-template-haskell-devel %if %{with tests} +BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-bytestring-devel +BuildRequires: ghc-genvalidity-devel +BuildRequires: ghc-genvalidity-property-devel BuildRequires: ghc-hspec-devel BuildRequires: ghc-mtl-devel +BuildRequires: ghc-validity-devel %endif %description @@ -56,6 +61,7 @@ %prep %setup -q -n %{pkg_name}-%{version} +cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build @@ -73,7 +79,7 @@ %ghc_pkg_recache %files -f %{name}.files -%doc LICENSE +%license LICENSE %files devel -f %{name}-devel.files %doc CHANGELOG README.md ++++++ path-0.5.13.tar.gz -> path-0.6.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-0.5.13/CHANGELOG new/path-0.6.1/CHANGELOG --- old/path-0.5.13/CHANGELOG 2017-03-17 18:41:41.000000000 +0100 +++ new/path-0.6.1/CHANGELOG 2017-07-01 07:58:06.000000000 +0200 @@ -1,3 +1,24 @@ +0.6.1: + * Add 'addFileExtension' function and its operator form: (<.>). + * Derive 'Eq' instance for 'PathException'. + +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: @@ -28,7 +49,7 @@ 0.2.0: - * Rename parentAbs to simply parent. + * Rename parentAbs to simply parent. * Add dirname. 0.3.0: diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-0.5.13/path.cabal new/path-0.6.1/path.cabal --- old/path-0.5.13/path.cabal 2017-03-17 19:50:36.000000000 +0100 +++ new/path-0.6.1/path.cabal 2017-07-01 07:53:42.000000000 +0200 @@ -1,5 +1,5 @@ name: path -version: 0.5.13 +version: 0.6.1 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-0.5.13/src/Path/Internal.hs new/path-0.6.1/src/Path/Internal.hs --- old/path-0.5.13/src/Path/Internal.hs 2017-03-07 21:37:13.000000000 +0100 +++ new/path-0.6.1/src/Path/Internal.hs 2017-06-15 10:58:48.000000000 +0200 @@ -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. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-0.5.13/src/Path.hs new/path-0.6.1/src/Path.hs --- old/path-0.5.13/src/Path.hs 2017-03-17 19:04:02.000000000 +0100 +++ new/path-0.6.1/src/Path.hs 2017-07-01 07:57:47.000000000 +0200 @@ -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,21 @@ ,relfile -- * Operations ,(</>) - ,stripDir - ,isParentOf + ,stripProperPrefix + ,isProperPrefixOf ,parent ,filename ,dirname ,fileExtension + ,addFileExtension + ,(<.>) ,setFileExtension + ,(-<.>) -- * Parsing ,parseAbsDir ,parseRelDir ,parseAbsFile ,parseRelFile - ,PathParseException -- * Conversion ,toFilePath ,fromAbsDir @@ -55,6 +70,10 @@ ,mkRelDir ,mkAbsFile ,mkRelFile + -- * Deprecated + ,PathParseException + ,stripDir + ,isParentOf ) where @@ -77,10 +96,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 +131,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 - deriving (Show,Typeable) -instance Exception PathParseException - + | NotAProperPrefix FilePath FilePath + deriving (Show,Eq,Typeable) +instance Exception PathException -------------------------------------------------------------------------------- -- QuasiQuoters @@ -215,58 +233,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 +317,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. -- @@ -294,6 +332,50 @@ fileExtension :: Path b File -> String fileExtension = FilePath.takeExtension . toFilePath +-- | Add extension to given file path. Throws if the +-- resulting filename does not parse. +-- +-- >>> addFileExtension "txt $(mkRelFile "foo") +-- "foo.txt" +-- >>> addFileExtension "symbols" $(mkRelFile "Data.List") +-- "Data.List.symbols" +-- >>> addFileExtension ".symbols" $(mkRelFile "Data.List") +-- "Data.List.symbols" +-- >>> addFileExtension "symbols" $(mkRelFile "Data.List.") +-- "Data.List..symbols" +-- >>> addFileExtension ".symbols" $(mkRelFile "Data.List.") +-- "Data.List..symbols" +-- >>> addFileExtension "evil/" $(mkRelFile "Data.List") +-- *** Exception: InvalidRelFile "Data.List.evil/" +-- +-- @since 0.6.1 +addFileExtension :: MonadThrow m + => String -- ^ Extension to add + -> Path b File -- ^ Old file name + -> m (Path b File) -- ^ New file name with the desired extension added at the end +addFileExtension ext (Path path) = + if FilePath.isAbsolute path + then liftM coercePath (parseAbsFile (FilePath.addExtension path ext)) + else liftM coercePath (parseRelFile (FilePath.addExtension path ext)) + where coercePath :: Path a b -> Path a' b' + coercePath (Path a) = Path a + +-- | A synonym for 'addFileExtension' in the form of an operator. +-- See more examples there. +-- +-- >>> $(mkRelFile "Data.List") <.> "symbols" +-- "Data.List.symbols" +-- >>> $(mkRelFile "Data.List") <.> "evil/" +-- *** Exception: InvalidRelFile "Data.List.evil/" +-- +-- @since 0.6.1 +infixr 7 <.> +(<.>) :: MonadThrow m + => Path b File -- ^ Old file name + -> String -- ^ Extension to add + -> m (Path b File) -- ^ New file name with the desired extension added at the end +(<.>) = flip addFileExtension + -- | Replace\/add extension to given file path. Throws if the -- resulting filename does not parse. -- @@ -309,16 +391,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 +423,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 +436,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 +473,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 +506,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 @@ -477,16 +565,20 @@ Right (Path str) -> [|Path $(return (LitE (StringL str))) :: Path Rel File|] - -------------------------------------------------------------------------------- -- 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 +592,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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-0.5.13/test/Path/Gen.hs new/path-0.6.1/test/Path/Gen.hs --- old/path-0.5.13/test/Path/Gen.hs 2017-03-11 15:49:16.000000000 +0100 +++ new/path-0.6.1/test/Path/Gen.hs 2017-06-06 17:36:23.000000000 +0200 @@ -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-0.5.13/test/Posix.hs new/path-0.6.1/test/Posix.hs --- old/path-0.5.13/test/Posix.hs 2017-03-17 18:41:41.000000000 +0100 +++ new/path-0.6.1/test/Posix.hs 2017-07-01 07:58:38.000000000 +0200 @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE QuasiQuotes #-} @@ -23,11 +24,14 @@ 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: addFileExtension" operationAddFileExtension + describe "Operations: setFileExtension" operationSetFileExtension describe "Restrictions" restrictions describe "Aeson Instances" aesonInstances describe "QuasiQuotes" quasiquotes @@ -45,7 +49,6 @@ -- parseFails "../" parseFails ".." - parseFails "." parseFails "/.." parseFails "/foo/../bar/" parseFails "/foo/bar/.." @@ -69,6 +72,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 +97,53 @@ (parent ($(mkAbsDir "/foo") </> $(mkRelDir "bar")) == $(mkAbsDir "/foo")) - it "parent \"\" == \"\"" - (parent $(mkAbsDir "/") == - $(mkAbsDir "/")) - it "parent (parent \"\") == \"\"" - (parent (parent $(mkAbsDir "/")) == - $(mkAbsDir "/")) - --- | The 'isParentOf' operation. -operationIsParentOf :: Spec -operationIsParentOf = - do it "isParentOf parent (parent </> child) (unit test)" - (isParentOf + 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 '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 +162,63 @@ ($(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 ".") == "\"./\"") + +operationAddFileExtension :: Spec +operationAddFileExtension = do + it "adds extension if there is none" $ + addFileExtension "ext" $(mkAbsFile "/directory/path") + `shouldReturn` $(mkAbsFile "/directory/path.ext") + it "adds extension if there is already one" $ + addFileExtension "baz" $(mkRelFile "foo.bar") + `shouldReturn` $(mkRelFile "foo.bar.baz") + it "adds extension with dot" $ + addFileExtension ".bar" $(mkRelFile "foo") + `shouldReturn` $(mkRelFile "foo.bar") + it "adds extension with dot after dot" $ + $(mkRelFile "foo.") <.> ".bar" + `shouldReturn` $(mkRelFile "foo..bar") + it "adds extension without dot after dot" $ + $(mkRelFile "foo.") <.> "bar" + `shouldReturn` $(mkRelFile "foo..bar") + it "adds extension with separator" $ -- I'm not sure it's okay + $(mkRelFile "foo") <.> "evil/extension" + `shouldReturn` $(mkRelFile "foo.evil/extension") + it "adds extension to file inside dotted directory" $ + $(mkRelFile "foo.bar/baz") <.> "txt" + `shouldReturn` $(mkRelFile "foo.bar/baz.txt") + it "throws InvalidRelFile extension if extenstion ends with /" $ + $(mkRelFile "foo") <.> "evil/" + `shouldThrow` (== InvalidRelFile "foo.evil/") + it "throws InvalidAbsFile extension if extenstion ends with /" $ + $(mkAbsFile "/home/cfg") <.> "txt/" -- No Eq instance for PathException + `shouldThrow` (== InvalidAbsFile "/home/cfg.txt/") + +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 +242,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" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-0.5.13/test/ValidityTest.hs new/path-0.6.1/test/ValidityTest.hs --- old/path-0.5.13/test/ValidityTest.hs 2017-03-10 23:38:40.000000000 +0100 +++ new/path-0.6.1/test/ValidityTest.hs 2017-06-14 11:22:34.000000000 +0200 @@ -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,94 +49,96 @@ 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 = it "Produces valid paths when it succeeds" $ - validIfSucceedsOnGen parser genFilePath \ No newline at end of file + validIfSucceedsOnGen parser genFilePath diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/path-0.5.13/test/Windows.hs new/path-0.6.1/test/Windows.hs --- old/path-0.5.13/test/Windows.hs 2017-03-17 18:41:41.000000000 +0100 +++ new/path-0.6.1/test/Windows.hs 2017-07-01 07:59:01.000000000 +0200 @@ -1,6 +1,7 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} -- | Test suite. @@ -23,11 +24,14 @@ 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: addFileExtension" operationAddFileExtension + describe "Operations: setFileExtension" operationSetFileExtension describe "Restrictions" restrictions describe "Aeson Instances" aesonInstances describe "QuasiQuotes" quasiquotes @@ -37,7 +41,6 @@ restrictions = do parseFails "..\\" parseFails ".." - parseFails "." parseSucceeds "a.." (Path "a..\\") parseSucceeds "..a" (Path "..a\\") parseFails "\\.." @@ -63,6 +66,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 +94,53 @@ (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:\\")) - --- | The 'isParentOf' operation. -operationIsParentOf :: Spec -operationIsParentOf = - do it "isParentOf parent (parent </> child) (unit test)" - (isParentOf + 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 '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 +159,63 @@ ($(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 ".") == "\".\\\\\"") + +operationAddFileExtension :: Spec +operationAddFileExtension = do + it "adds extension if there is none" $ + addFileExtension "ext" $(mkAbsFile "C:\\directory\\path") + `shouldReturn` $(mkAbsFile "C:\\directory\\path.ext") + it "adds extension if there is already one" $ + addFileExtension "baz" $(mkRelFile "foo.bar") + `shouldReturn` $(mkRelFile "foo.bar.baz") + it "adds extension with dot" $ + addFileExtension ".bar" $(mkRelFile "foo") + `shouldReturn` $(mkRelFile "foo.bar") + it "adds extension with dot after dot" $ + $(mkRelFile "foo.") <.> ".bar" + `shouldReturn` $(mkRelFile "foo..bar") + it "adds extension without dot after dot" $ + $(mkRelFile "foo.") <.> "bar" + `shouldReturn` $(mkRelFile "foo..bar") + it "adds extension with separator" $ -- I'm not sure it's okay + $(mkRelFile "foo") <.> "evil\\extension" + `shouldReturn` $(mkRelFile "foo.evil\\extension") + it "adds extension to file inside dotted directory" $ + $(mkRelFile "foo.bar\\baz") <.> "txt" + `shouldReturn` $(mkRelFile "foo.bar\\baz.txt") + it "throws InvalidRelFile extension if extenstion ends with \\" $ + $(mkRelFile "foo") <.> "evil\\" + `shouldThrow` (== InvalidRelFile "foo.evil\\") + it "throws InvalidAbsFile extension if extenstion ends with \\" $ + $(mkAbsFile "C:\\home\\cfg") <.> "txt\\" + `shouldThrow` (== InvalidAbsFile "C:\\home\\cfg.txt\\") + +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 +239,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 +351,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")) ++++++ path.cabal ++++++ name: path version: 0.6.1 x-revision: 1 synopsis: Support for well-typed paths description: Support for well-typed paths. license: BSD3 license-file: LICENSE author: Chris Done <[email protected]> maintainer: Chris Done <[email protected]> copyright: 2015–2017 FP Complete 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 library hs-source-dirs: src ghc-options: -Wall -O2 exposed-modules: Path, Path.Internal build-depends: aeson , base >= 4.7 && < 5 , deepseq , exceptions >= 0.4 && < 0.11 , filepath < 1.2.0.1 || >= 1.3 , hashable >= 1.2 && < 1.3 , template-haskell default-language: Haskell2010 test-suite test type: exitcode-stdio-1.0 main-is: Main.hs other-modules: Posix , Windows hs-source-dirs: test build-depends: aeson , base >= 4.7 && < 5 , bytestring , filepath < 1.2.0.1 || >= 1.3 , hspec >= 2.0 && < 3 , mtl >= 2.0 && < 3 , path default-language: Haskell2010 test-suite validity-test type: exitcode-stdio-1.0 main-is: ValidityTest.hs other-modules: Path.Gen hs-source-dirs: test build-depends: QuickCheck , aeson , base >= 4.7 && < 5 , bytestring , filepath < 1.2.0.1 || >= 1.3 , genvalidity >= 0.3 && < 0.4 , genvalidity-property >= 0.0 && < 0.1 , hspec >= 2.0 && < 3 , mtl >= 2.0 && < 3 , path , validity >= 0.3.1.1 && < 0.4 default-language: Haskell2010 ghc-options: -threaded -rtsopts -with-rtsopts=-N source-repository head type: git location: https://github.com/commercialhaskell/path.git
