path 0.5.12 → 0.5.13
raw patch · 10 files changed
+981/−567 lines, 10 filesdep −HUnitdep ~aesondep ~basedep ~deepseqnew-uploader
Dependencies removed: HUnit
Dependency ranges changed: aeson, base, deepseq, exceptions, filepath, hspec, mtl, template-haskell
Files
- CHANGELOG +2/−0
- README.md +20/−4
- path.cabal +42/−39
- src/Path.hs +247/−183
- src/Path/Internal.hs +25/−2
- test/Main.hs +7/−271
- test/Path/Gen.hs +32/−18
- test/Posix.hs +291/−0
- test/ValidityTest.hs +30/−50
- test/Windows.hs +285/−0
CHANGELOG view
@@ -1,3 +1,5 @@+0.5.13:+ * Add QuasiQuoters absdir, reldir, absfile, relfile 0.5.11: * Add replaceExtension and fileExtension
README.md view
@@ -1,5 +1,11 @@ # Path +[](https://travis-ci.org/commercialhaskell/path)+[](https://ci.appveyor.com/project/chrisdone/path)+[](https://hackage.haskell.org/package/path)+[](http://stackage.org/lts/package/path)+[](http://stackage.org/nightly/package/path)+ Support for well-typed paths in Haskell. * [Motivation](#motivation)@@ -213,6 +219,16 @@ $(mkRelFile "chris/x.txt") ``` +With the [QuasiQuotes](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#ghc-flag--XQuasiQuotes)+language extension, paths can be written as follows:++```haskell+[absdir|/home/chris|]+[reldir|chris|]+[absfile|/home/chris/x.txt|]+[relfile|chris/x.txt|]+```+ These will run at compile-time and underneath use the appropriate parser. ### Overloaded strings@@ -267,7 +283,7 @@ absolute. You can’t append two absolute paths, for example: ```haskell-λ> $(mkAbsDir "/home/chris") </> $(mkAbsDir "/home/chris")+λ> [absdir|/home/chris|]</>[absdir|/home/chris|] <interactive>:23:31-55: Couldn't match type ‘Abs’ with ‘Rel’ ```@@ -298,7 +314,7 @@ "/home/chris/" λ> toFilePath $(mkRelDir "foo//bar") "foo/bar/"-λ> $(mkAbsDir "/home/chris//") </> $(mkRelDir "foo//bar")+λ> [absdir|/home/chris//|]</>[reldir|foo//bar|] "/home/chris/foo/bar/" ``` @@ -308,9 +324,9 @@ prevents improper appending: ```haskell-λ> $(mkAbsDir "/home/chris/") </> $(mkRelFile "foo//bar")+λ> [absdir|/home/chris/|]</>[relfile|foo//bar|] "/home/chris/foo/bar"-λ> $(mkAbsFile "/home/chris") </> $(mkRelFile "foo//bar")+λ> [absfile|/home/chris|]</>[relfile|foo//bar|] <interactive>:35:1-26: Couldn't match type ‘File’ with ‘Dir’ ```
path.cabal view
@@ -1,15 +1,15 @@ name: path-version: 0.5.12+version: 0.5.13 synopsis: Support for well-typed paths description: Support for well-typed paths. license: BSD3 license-file: LICENSE author: Chris Done <chrisdone@fpcomplete.com> maintainer: Chris Done <chrisdone@fpcomplete.com>-copyright: 2015–2016 FP Complete-category: Filesystem+copyright: 2015–2017 FP Complete+category: System, Filesystem build-type: Simple-cabal-version: >=1.8+cabal-version: >=1.10 extra-source-files: README.md, CHANGELOG flag validity@@ -18,52 +18,55 @@ description: Enable validity tests. library- hs-source-dirs: src/+ hs-source-dirs: src ghc-options: -Wall -O2 exposed-modules: Path, Path.Internal- build-depends: base >= 4 && <5- , exceptions- , filepath < 1.2.0.1 || >= 1.3- , template-haskell+ build-depends: aeson+ , base >= 4.7 && < 5 , deepseq- , aeson- , hashable >= 1.2 && < 1.3+ , exceptions >= 0.4 && < 0.9+ , 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- hs-source-dirs: test- build-depends: HUnit- , QuickCheck- , aeson- , base- , bytestring- , filepath- , hspec- , mtl- , path+ 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- if !flag(validity)- buildable: False- type: exitcode-stdio-1.0- main-is: ValidityTest.hs- other-modules: Path.Gen- hs-source-dirs: test- if flag(validity)- build-depends: HUnit- , QuickCheck+ 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 , aeson- , base >= 4.9 && < 5+ , base >= 4.9 && < 5 , bytestring- , filepath+ , filepath < 1.2.0.1 || >= 1.3 , genvalidity >= 0.3 && < 0.4 , genvalidity-hspec >= 0.3 && < 0.4- , hspec- , mtl+ , hspec >= 2.0 && < 3+ , mtl >= 2.0 && < 3 , path- , validity >= 0.3.1.1 && < 0.4+ , 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/chrisdone/path.git+ type: git+ location: https://github.com/commercialhaskell/path.git
src/Path.hs view
@@ -1,13 +1,4 @@--- |--- Module : Path--- Copyright : © 2015–2016 FP Complete--- License : BSD 3 clause------ Maintainer : Chris Done <chrisdone@fpcomplete.com>--- Stability : experimental--- Portability : portable------ Support for well-typed paths.+-- | Support for well-typed paths. {-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-}@@ -23,17 +14,20 @@ ,Rel ,File ,Dir- -- * Parsing- ,parseAbsDir- ,parseRelDir- ,parseAbsFile- ,parseRelFile- ,PathParseException- -- * Constructors- ,mkAbsDir- ,mkRelDir- ,mkAbsFile- ,mkRelFile+ -- * QuasiQuoters+ -- | Using the following requires the QuasiQuotes language extension.+ --+ -- __For Windows users__, the QuasiQuoters are especially beneficial because they+ -- prevent Haskell from treating @\\@ as an escape character.+ -- This makes Windows paths easier to write.+ --+ -- @+ -- [absfile|C:\\chris\\foo.txt|]+ -- @+ ,absdir+ ,reldir+ ,absfile+ ,relfile -- * Operations ,(</>) ,stripDir@@ -43,24 +37,37 @@ ,dirname ,fileExtension ,setFileExtension+ -- * Parsing+ ,parseAbsDir+ ,parseRelDir+ ,parseAbsFile+ ,parseRelFile+ ,PathParseException -- * Conversion ,toFilePath ,fromAbsDir ,fromRelDir ,fromAbsFile ,fromRelFile+ -- * TemplateHaskell constructors+ -- | These require the TemplateHaskell language extension.+ ,mkAbsDir+ ,mkRelDir+ ,mkAbsFile+ ,mkRelFile ) where import Control.Exception (Exception)+import Control.Monad import Control.Monad.Catch (MonadThrow(..)) import Data.Aeson (FromJSON (..)) import qualified Data.Aeson.Types as Aeson-import Data.Coerce import Data.Data import Data.List import Data.Maybe import Language.Haskell.TH+import Language.Haskell.TH.Quote (QuasiQuoter(..)) import Path.Internal import qualified System.FilePath as FilePath @@ -117,7 +124,193 @@ deriving (Show,Typeable) instance Exception PathParseException + --------------------------------------------------------------------------------+-- QuasiQuoters++qq :: (String -> Q Exp) -> QuasiQuoter+qq quoteExp' =+ QuasiQuoter+ { quoteExp = quoteExp'+ , quotePat = \_ ->+ fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"+ , quoteType = \_ ->+ fail "illegal QuasiQuote (allowed as expression only, used as a type)"+ , quoteDec = \_ ->+ fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"+ }++-- | Construct a 'Path' 'Abs' 'Dir' using QuasiQuotes.+--+-- @+-- [absdir|/|]+--+-- [absdir|\/home\/chris|]+-- @+--+-- Remember: due to the nature of absolute paths a path like @[absdir|\/home\/chris|]@+-- may compile on your platform, but it may not compile on another+-- platform (Windows).+--+-- @since 0.5.13+absdir :: QuasiQuoter+absdir = qq mkAbsDir++-- | Construct a 'Path' 'Rel' 'Dir' using QuasiQuotes.+--+-- @+-- [absdir|\/home|]\<\/>[reldir|chris|]+-- @+--+-- @since 0.5.13+reldir :: QuasiQuoter+reldir = qq mkRelDir++-- | Construct a 'Path' 'Abs' 'File' using QuasiQuotes.+--+-- @+-- [absfile|\/home\/chris\/foo.txt|]+-- @+--+-- Remember: due to the nature of absolute paths a path like @[absdir|\/home\/chris\/foo.txt|]@+-- may compile on your platform, but it may not compile on another+-- platform (Windows).+--+-- @since 0.5.13+absfile :: QuasiQuoter+absfile = qq mkAbsFile++-- | Construct a 'Path' 'Rel' 'File' using QuasiQuotes.+--+-- @+-- [absdir|\/home\/chris|]\<\/>[relfile|foo.txt|]+-- @+--+-- @since 0.5.13+relfile :: QuasiQuoter+relfile = qq mkRelFile++--------------------------------------------------------------------------------+-- Operations++-- | Append two paths.+--+-- The following cases are valid and the equalities hold:+--+-- @$(mkAbsDir x) \<\/> $(mkRelDir y) = $(mkAbsDir (x ++ \"/\" ++ y))@+--+-- @$(mkAbsDir x) \<\/> $(mkRelFile y) = $(mkAbsFile (x ++ \"/\" ++ y))@+--+-- @$(mkRelDir x) \<\/> $(mkRelDir y) = $(mkRelDir (x ++ \"/\" ++ y))@+--+-- @$(mkRelDir x) \<\/> $(mkRelFile y) = $(mkRelFile (x ++ \"/\" ++ y))@+--+-- The following are proven not possible to express:+--+-- @$(mkAbsFile …) \<\/> x@+--+-- @$(mkRelFile …) \<\/> x@+--+-- @x \<\/> $(mkAbsFile …)@+--+-- @x \<\/> $(mkAbsDir …)@+--+(</>) :: 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.+--+-- The following properties hold:+--+-- @stripDir x (x \<\/> y) = y@+--+-- Cases which are proven not possible:+--+-- @stripDir (a :: Path Abs …) (b :: Path Rel …)@+--+-- @stripDir (a :: Path Rel …) (b :: Path Abs …)@+--+-- In other words the bases must match.+--+stripDir :: MonadThrow m+ => Path b Dir -> Path b t -> m (Path Rel t)+stripDir (Path p) (Path l) =+ case stripPrefix p l of+ Nothing -> throwM (Couldn'tStripPrefixDir p l)+ Just "" -> throwM (Couldn'tStripPrefixDir p l)+ Just ok -> return (Path ok)++-- | Is p a parent of the given location? Implemented in terms of+-- 'stripDir'. The bases must match.+--+-- The following properties hold:+--+-- @not (x \`isParentOf\` x)@+--+-- @x \`isParentOf\` (x \<\/\> y)@+--+isParentOf :: Path b Dir -> Path b t -> Bool+isParentOf p l =+ isJust (stripDir p l)++-- | Take the absolute parent directory from the absolute path.+--+-- The following properties hold:+--+-- @parent (x \<\/> y) == x@+--+-- On the root, getting the parent is idempotent:+--+-- @parent (parent \"\/\") = \"\/\"@+--+parent :: Path Abs t -> Path Abs Dir+parent (Path fp) =+ Path (normalizeDir (FilePath.takeDirectory (FilePath.dropTrailingPathSeparator fp)))++-- | Extract the file part of a path.+--+-- The following properties hold:+--+-- @filename (p \<\/> a) == filename a@+--+filename :: Path b File -> Path Rel File+filename (Path l) =+ Path (FilePath.takeFileName l)++-- | Extract the last directory name of a path.+--+-- The following properties hold:+--+-- @dirname (p \<\/> a) == dirname a@+--+dirname :: Path b Dir -> Path Rel Dir+dirname (Path l) =+ Path (last (FilePath.splitPath l))++-- | Get extension from given file path.+--+-- @since 0.5.11+fileExtension :: Path b File -> String+fileExtension = FilePath.takeExtension . toFilePath++-- | Replace\/add extension to given file path. Throws if the+-- resulting filename does not parse.+--+-- @since 0.5.11+setFileExtension :: MonadThrow m+ => String -- ^ Extension to set+ -> Path b File -- ^ Old file name+ -> m (Path b File) -- ^ New file name with the desired extension+setFileExtension ext (Path path) =+ if FilePath.isAbsolute path+ then liftM coercePath (parseAbsFile (FilePath.replaceExtension path ext))+ else liftM coercePath (parseRelFile (FilePath.replaceExtension path ext))+ where coercePath :: Path a b -> Path a' b'+ coercePath (Path a) = Path a+++-------------------------------------------------------------------------------- -- Parsers -- | Convert an absolute 'FilePath' to a normalized absolute dir 'Path'.@@ -154,7 +347,6 @@ not (null filepath) && filepath /= "." && normalizeFilePath filepath /= curDirNormalizedFP &&- filepath /= ".." && FilePath.isValid filepath then return (Path (normalizeDir filepath)) else throwM (InvalidRelDir filepath)@@ -213,25 +405,39 @@ (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) && not (null filepath) && not (hasParentDir filepath) &&- filepath /= "." && filepath /= ".." && FilePath.isValid filepath+ filepath /= "." && FilePath.isValid filepath --- | Helper function: check if the filepath has any parent directories in it.--- This handles the logic of checking for different path separators on Windows.-hasParentDir :: FilePath -> Bool-hasParentDir filepath' =- ("/.." `isSuffixOf` filepath) ||- ("/../" `isInfixOf` filepath) ||- ("../" `isPrefixOf` filepath)- where- filepath =- case FilePath.pathSeparator of- '/' -> filepath'- x -> map (\y -> if x == y then '/' else y) filepath'+--------------------------------------------------------------------------------+-- 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++-- | Convert relative path to directory to 'FilePath' type.+fromRelDir :: Path Rel Dir -> FilePath+fromRelDir = toFilePath++-- | Convert absolute path to file to 'FilePath' type.+fromAbsFile :: Path Abs File -> FilePath+fromAbsFile = toFilePath++-- | Convert relative path to file to 'FilePath' type.+fromRelFile :: Path Rel File -> FilePath+fromRelFile = toFilePath+ -------------------------------------------------------------------------------- -- Constructors --- | Make a 'Path Abs Dir'.+-- | Make a 'Path' 'Abs' Dir'. -- -- Remember: due to the nature of absolute paths this (e.g. @\/home\/foo@) -- may compile on your platform, but it may not compile on another@@ -243,7 +449,7 @@ Right (Path str) -> [|Path $(return (LitE (StringL str))) :: Path Abs Dir|] --- | Make a 'Path Rel Dir'.+-- | Make a 'Path' 'Rel' 'Dir'. mkRelDir :: FilePath -> Q Exp mkRelDir s = case parseRelDir s of@@ -251,7 +457,7 @@ Right (Path str) -> [|Path $(return (LitE (StringL str))) :: Path Rel Dir|] --- | Make a 'Path Abs File'.+-- | Make a 'Path' 'Abs' 'File'. -- -- Remember: due to the nature of absolute paths this (e.g. @\/home\/foo@) -- may compile on your platform, but it may not compile on another@@ -263,7 +469,7 @@ Right (Path str) -> [|Path $(return (LitE (StringL str))) :: Path Abs File|] --- | Make a 'Path Rel File'.+-- | Make a 'Path' 'Rel' 'File'. mkRelFile :: FilePath -> Q Exp mkRelFile s = case parseRelFile s of@@ -271,151 +477,8 @@ Right (Path str) -> [|Path $(return (LitE (StringL str))) :: Path Rel File|] ------------------------------------------------------------------------------------ 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---- | Convert relative path to directory to 'FilePath' type.-fromRelDir :: Path Rel Dir -> FilePath-fromRelDir = toFilePath---- | Convert absolute path to file to 'FilePath' type.-fromAbsFile :: Path Abs File -> FilePath-fromAbsFile = toFilePath---- | Convert relative path to file to 'FilePath' type.-fromRelFile :: Path Rel File -> FilePath-fromRelFile = toFilePath- ----------------------------------------------------------------------------------- Operations---- | Append two paths.------ The following cases are valid and the equalities hold:------ @$(mkAbsDir x) \<\/> $(mkRelDir y) = $(mkAbsDir (x ++ \"/\" ++ y))@------ @$(mkAbsDir x) \<\/> $(mkRelFile y) = $(mkAbsFile (x ++ \"/\" ++ y))@------ @$(mkRelDir x) \<\/> $(mkRelDir y) = $(mkRelDir (x ++ \"/\" ++ y))@------ @$(mkRelDir x) \<\/> $(mkRelFile y) = $(mkRelFile (x ++ \"/\" ++ y))@------ The following are proven not possible to express:------ @$(mkAbsFile …) \<\/> x@------ @$(mkRelFile …) \<\/> x@------ @x \<\/> $(mkAbsFile …)@------ @x \<\/> $(mkAbsDir …)@----(</>) :: 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.------ The following properties hold:------ @stripDir x (x \<\/> y) = y@------ Cases which are proven not possible:------ @stripDir (a :: Path Abs …) (b :: Path Rel …)@------ @stripDir (a :: Path Rel …) (b :: Path Abs …)@------ In other words the bases must match.----stripDir :: MonadThrow m- => Path b Dir -> Path b t -> m (Path Rel t)-stripDir (Path p) (Path l) =- case stripPrefix p l of- Nothing -> throwM (Couldn'tStripPrefixDir p l)- Just "" -> throwM (Couldn'tStripPrefixDir p l)- Just ok -> return (Path ok)---- | Is p a parent of the given location? Implemented in terms of--- 'stripDir'. The bases must match.------ The following properties hold:------ @not (x `isParentOf` x)@------ @x `isParentOf` (x \<\/\> y)@----isParentOf :: Path b Dir -> Path b t -> Bool-isParentOf p l =- isJust (stripDir p l)---- | Take the absolute parent directory from the absolute path.------ The following properties hold:------ @parent (x \<\/> y) == x@------ On the root, getting the parent is idempotent:------ @parent (parent \"\/\") = \"\/\"@----parent :: Path Abs t -> Path Abs Dir-parent (Path fp) =- Path (normalizeDir (FilePath.takeDirectory (FilePath.dropTrailingPathSeparator fp)))---- | Extract the file part of a path.------ The following properties hold:------ @filename (p \<\/> a) == filename a@----filename :: Path b File -> Path Rel File-filename (Path l) =- Path (FilePath.takeFileName l)---- | Extract the last directory name of a path.------ The following properties hold:------ @dirname (p \<\/> a) == dirname a@----dirname :: Path b Dir -> Path Rel Dir-dirname (Path l) =- Path (last (FilePath.splitPath l))---- | Get extension from given file path.------ @since 0.5.11-fileExtension :: Path b File -> String-fileExtension = FilePath.takeExtension . toFilePath---- | Replace\/add extension to given file path. Throws if the--- resulting filename does not parse.------ @since 0.5.11-setFileExtension :: MonadThrow m- => String -- ^ Extension to set- -> Path b File -- ^ Old file name- -> m (Path b File) -- ^ New file name with the desired extension-setFileExtension ext (Path path) =- if FilePath.isAbsolute path- then fmap coerce (parseAbsFile (FilePath.replaceExtension path ext))- else fmap coerce (parseRelFile (FilePath.replaceExtension path ext))---------------------------------------------------------------------------------- -- Internal functions curDirNormalizedFP :: FilePath@@ -436,3 +499,4 @@ = normalizeLeadingSeparators (sep:xs) normalizeLeadingSeparators x = x #endif+
src/Path/Internal.hs view
@@ -4,16 +4,25 @@ -- | Internal types and functions. module Path.Internal- (Path(..))+ ( Path(..)+ , hasParentDir+ ) where import Control.DeepSeq (NFData (..)) import Data.Aeson (ToJSON (..)) import Data.Data import Data.Hashable+import Data.List+import qualified System.FilePath as FilePath -- | Path of some base and type. --+-- The type variables are:+--+-- * @b@ — base, the base location of the path; absolute or relative.+-- * @t@ — type, whether file or directory.+-- -- Internally is a string. The string can be of two formats only: -- -- 1. File format: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@@@ -40,7 +49,7 @@ instance Ord (Path b t) where compare (Path x) (Path y) = compare x y --- | Same as 'Path.toFilePath'.+-- | Same as 'show . Path.toFilePath'. -- -- The following property holds: --@@ -61,3 +70,17 @@ instance Hashable (Path b t) where hashWithSalt n (Path path) = hashWithSalt n 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.+hasParentDir :: FilePath -> Bool+hasParentDir filepath' =+ (filepath' == "..") ||+ ("/.." `isSuffixOf` filepath) ||+ ("/../" `isInfixOf` filepath) ||+ ("../" `isPrefixOf` filepath)+ where+ filepath =+ case FilePath.pathSeparator of+ '/' -> filepath'+ x -> map (\y -> if x == y then '/' else y) filepath'
test/Main.hs view
@@ -1,279 +1,15 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} --- | Test suite.+module Main (main) where -module Main where+#ifdef mingw32_HOST_OS+import Windows (spec)+#else+import Posix (spec)+#endif -import Control.Applicative-import Control.Monad-import Data.Aeson-import qualified Data.ByteString.Lazy.Char8 as LBS-import Data.Maybe-import Path-import Path.Internal import Test.Hspec-import Test.QuickCheck -- | Test suite entry point, returns exit failure if any test fails. main :: IO () main = hspec spec---- | Test suite.-spec :: Spec-spec =- do describe "Parsing: Path Abs Dir" parseAbsDirSpec- describe "Parsing: Path Rel Dir" parseRelDirSpec- describe "Parsing: Path Abs File" parseAbsFileSpec- describe "Parsing: Path Rel File" parseRelFileSpec- describe "Operations: (</>)" operationAppend- describe "Operations: stripDir" operationStripDir- describe "Operations: isParentOf" operationIsParentOf- describe "Operations: parent" operationParent- describe "Operations: filename" operationFilename- describe "Operations: dirname" operationDirname- describe "Restrictions" restrictions- describe "Aeson Instances" aesonInstances---- | Restricting the input of any tricks.-restrictions :: Spec-restrictions =- do -- These ~ related ones below are now lifted:- -- https://github.com/chrisdone/path/issues/19- parseSucceeds "~/" (Path "~/")- parseSucceeds "~/foo" (Path "~/foo/")- parseSucceeds "~/foo/bar" (Path "~/foo/bar/")- --- parseFails "../"- parseFails ".."- parseFails "."- parseFails "/.."- parseFails "/foo/../bar/"- parseFails "/foo/bar/.."- parseFailsPending "/hello/\n/world"- parseFailsPending "white/\r/space"- where parseFails x =- it (show x ++ " should be rejected")- (isNothing (void (parseAbsDir x) <|>- void (parseRelDir x) <|>- void (parseAbsFile x) <|>- void (parseRelFile x)))- parseFailsPending x =- it (show x ++ " should be rejected")- pending- parseSucceeds x with =- parserTest parseRelDir x (Just with)---- | The 'dirname' operation.-operationDirname :: Spec-operationDirname = do- it- "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"- (dirname ($(mkAbsDir "/home/chris/") </> $(mkRelDir "bar")) ==- dirname $(mkRelDir "bar"))- it- "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"- (dirname ($(mkRelDir "home/chris/") </> $(mkRelDir "bar")) ==- dirname $(mkRelDir "bar"))---- | The 'filename' operation.-operationFilename :: Spec-operationFilename =- do it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"- (filename ($(mkAbsDir "/home/chris/") </>- $(mkRelFile "bar.txt")) ==- filename $(mkRelFile "bar.txt"))-- it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"- (filename ($(mkRelDir "home/chris/") </>- $(mkRelFile "bar.txt")) ==- filename $(mkRelFile "bar.txt"))---- | The 'parent' operation.-operationParent :: Spec-operationParent =- do it "parent (parent </> child) == parent"- (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- $(mkAbsDir "///bar/")- ($(mkAbsDir "///bar/") </>- $(mkRelFile "bar/foo.txt")))-- it "isParentOf parent (parent </> child) (unit test)"- (isParentOf- $(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/")- ($(mkAbsDir "///bar/") </>- $(mkRelFile "bar/foo.txt")) ==- Just $(mkRelFile "bar/foo.txt"))-- it "stripDir parent (parent </> child) = child (unit test)"- (stripDir $(mkRelDir "bar/")- ($(mkRelDir "bar/") </>- $(mkRelFile "bob/foo.txt")) ==- Just $(mkRelFile "bob/foo.txt"))-- it "stripDir parent parent = _|_"- (stripDir $(mkAbsDir "/home/chris/foo")- $(mkAbsDir "/home/chris/foo") ==- Nothing)---- | The '</>' operation.-operationAppend :: Spec-operationAppend =- do it "AbsDir + RelDir = AbsDir"- ($(mkAbsDir "/home/") </>- $(mkRelDir "chris") ==- $(mkAbsDir "/home/chris/"))- it "AbsDir + RelFile = AbsFile"- ($(mkAbsDir "/home/") </>- $(mkRelFile "chris/test.txt") ==- $(mkAbsFile "/home/chris/test.txt"))- it "RelDir + RelDir = RelDir"- ($(mkRelDir "home/") </>- $(mkRelDir "chris") ==- $(mkRelDir "home/chris"))- it "RelDir + RelFile = RelFile"- ($(mkRelDir "home/") </>- $(mkRelFile "chris/test.txt") ==- $(mkRelFile "home/chris/test.txt"))---- | Tests for the tokenizer.-parseAbsDirSpec :: Spec-parseAbsDirSpec =- do failing ""- failing "./"- failing "foo.txt"- succeeding "/" (Path "/")- succeeding "//" (Path "/")- succeeding "///foo//bar//mu/" (Path "/foo/bar/mu/")- succeeding "///foo//bar////mu" (Path "/foo/bar/mu/")- succeeding "///foo//bar/.//mu" (Path "/foo/bar/mu/")-- where failing x = parserTest parseAbsDir x Nothing- succeeding x with = parserTest parseAbsDir x (Just with)---- | Tests for the tokenizer.-parseRelDirSpec :: Spec-parseRelDirSpec =- do failing ""- failing "/"- failing "//"- succeeding "~/" (Path "~/") -- https://github.com/chrisdone/path/issues/19- failing "/"- failing "./"- failing "././"- failing "//"- failing "///foo//bar//mu/"- failing "///foo//bar////mu"- failing "///foo//bar/.//mu"- succeeding "..." (Path ".../")- succeeding "foo.bak" (Path "foo.bak/")- succeeding "./foo" (Path "foo/")- succeeding "././foo" (Path "foo/")- succeeding "./foo/./bar" (Path "foo/bar/")- succeeding "foo//bar//mu//" (Path "foo/bar/mu/")- succeeding "foo//bar////mu" (Path "foo/bar/mu/")- succeeding "foo//bar/.//mu" (Path "foo/bar/mu/")-- where failing x = parserTest parseRelDir x Nothing- succeeding x with = parserTest parseRelDir x (Just with)---- | Tests for the tokenizer.-parseAbsFileSpec :: Spec-parseAbsFileSpec =- do failing ""- failing "./"- failing "/."- failing "/foo/bar/."- failing "~/"- failing "./foo.txt"- failing "/"- failing "//"- failing "///foo//bar//mu/"- succeeding "/..." (Path "/...")- succeeding "/foo.txt" (Path "/foo.txt")- succeeding "///foo//bar////mu.txt" (Path "/foo/bar/mu.txt")- succeeding "///foo//bar/.//mu.txt" (Path "/foo/bar/mu.txt")-- where failing x = parserTest parseAbsFile x Nothing- succeeding x with = parserTest parseAbsFile x (Just with)---- | Tests for the tokenizer.-parseRelFileSpec :: Spec-parseRelFileSpec =- do failing ""- failing "/"- failing "//"- failing "~/"- failing "/"- failing "./"- failing "a/."- failing "a/../b"- failing "a/.."- failing "../foo.txt"- failing "//"- failing "///foo//bar//mu/"- failing "///foo//bar////mu"- failing "///foo//bar/.//mu"- succeeding "a.." (Path "a..")- succeeding "..." (Path "...")- succeeding "foo.txt" (Path "foo.txt")- succeeding "./foo.txt" (Path "foo.txt")- succeeding "././foo.txt" (Path "foo.txt")- succeeding "./foo/./bar.txt" (Path "foo/bar.txt")- succeeding "foo//bar//mu.txt" (Path "foo/bar/mu.txt")- succeeding "foo//bar////mu.txt" (Path "foo/bar/mu.txt")- succeeding "foo//bar/.//mu.txt" (Path "foo/bar/mu.txt")-- where failing x = parserTest parseRelFile x Nothing- succeeding x with = parserTest parseRelFile x (Just with)---- | Parser test.-parserTest :: (Show a1,Show a,Eq a1)- => (a -> Maybe a1) -> a -> Maybe a1 -> SpecWith ()-parserTest parser input expected =- it ((case expected of- Nothing -> "Failing: "- Just{} -> "Succeeding: ") ++- "Parsing " ++- show input ++- " " ++- case expected of- Nothing -> "should fail."- Just x -> "should succeed with: " ++ show x)- (actual `shouldBe` expected)- where actual = parser input---- | Tests for the 'ToJSON' and 'FromJSON' instances------ Can't use overloaded strings due to some weird issue with bytestring-0.9.2.1 / ghc-7.4.2:--- https://travis-ci.org/sjakobi/path/jobs/138399072#L989-aesonInstances :: Spec-aesonInstances =- do it "Decoding \"[\"/foo/bar\"]\" as a [Path Abs Dir] should succeed." $- eitherDecode (LBS.pack "[\"/foo/bar\"]") `shouldBe` Right [Path "/foo/bar/" :: Path Abs Dir]- it "Decoding \"[\"/foo/bar\"]\" as a [Path Rel Dir] should fail." $- decode (LBS.pack "[\"/foo/bar\"]") `shouldBe` (Nothing :: Maybe [Path Rel Dir])- it "Encoding \"[\"/foo/bar/mu.txt\"]\" should succeed." $- encode [Path "/foo/bar/mu.txt" :: Path Abs File] `shouldBe` (LBS.pack "[\"/foo/bar/mu.txt\"]")
test/Path/Gen.hs view
@@ -6,6 +6,7 @@ import qualified System.FilePath as FilePath +import Data.Maybe (mapMaybe) import Data.List (isInfixOf) import Data.Validity import Data.GenValidity@@ -18,8 +19,7 @@ = FilePath.isAbsolute fp && not (FilePath.hasTrailingPathSeparator fp) && FilePath.isValid fp- && not (".." `isInfixOf` fp)- && not (containsLineBreaks fp)+ && not (hasParentDir fp) && (parseAbsFile fp == Just p) instance Validity (Path Rel File) where@@ -28,9 +28,7 @@ && not (FilePath.hasTrailingPathSeparator fp) && FilePath.isValid fp && fp /= "."- && fp /= ".."- && not (".." `isInfixOf` fp)- && not (containsLineBreaks fp)+ && not (hasParentDir fp) && (parseRelFile fp == Just p) instance Validity (Path Abs Dir) where@@ -38,8 +36,7 @@ = FilePath.isAbsolute fp && FilePath.hasTrailingPathSeparator fp && FilePath.isValid fp- && not (".." `isInfixOf` fp)- && not (containsLineBreaks fp)+ && not (hasParentDir fp) && (parseAbsDir fp == Just p) instance Validity (Path Rel Dir) where@@ -49,32 +46,49 @@ && FilePath.isValid fp && not (null fp) && fp /= "."- && fp /= ".."- && not (".." `isInfixOf` fp)- && not (containsLineBreaks fp)+ && not (hasParentDir fp) && (parseRelDir fp == Just p) --containsLineBreaks :: String -> Bool-containsLineBreaks s = any (`elem` s) "\n\r"- instance GenUnchecked (Path Abs File) where- genUnchecked = Path <$> arbitrary+ genUnchecked = Path <$> genFilePath instance GenValid (Path Abs File) instance GenUnchecked (Path Rel File) where- genUnchecked = Path <$> arbitrary+ genUnchecked = Path <$> genFilePath instance GenValid (Path Rel File) instance GenUnchecked (Path Abs Dir) where- genUnchecked = Path <$> arbitrary+ genUnchecked = Path <$> genFilePath instance GenValid (Path Abs Dir) instance GenUnchecked (Path Rel Dir) where- genUnchecked = Path <$> arbitrary+ genUnchecked = Path <$> genFilePath instance GenValid (Path Rel Dir) +-- | Generates 'FilePath's with a high occurence of @'.'@, @'\/'@ and+-- @'\\'@ characters. The resulting 'FilePath's are not guaranteed to+-- be valid.+genFilePath :: Gen FilePath+genFilePath = listOf genPathyChar++genPathyChar :: Gen Char+genPathyChar = frequency [(2, arbitrary), (1, elements "./\\")]++shrinkValidAbsFile :: Path Abs File -> [Path Abs File]+shrinkValidAbsFile = shrinkValidWith parseAbsFile++shrinkValidAbsDir :: Path Abs Dir -> [Path Abs Dir]+shrinkValidAbsDir = shrinkValidWith parseAbsDir++shrinkValidRelFile :: Path Rel File -> [Path Rel File]+shrinkValidRelFile = shrinkValidWith parseRelFile++shrinkValidRelDir :: Path Rel Dir -> [Path Rel Dir]+shrinkValidRelDir = shrinkValidWith parseRelDir++shrinkValidWith :: (FilePath -> Maybe (Path a b)) -> Path a b -> [Path a b]+shrinkValidWith fun (Path s) = mapMaybe fun $ shrink s
+ test/Posix.hs view
@@ -0,0 +1,291 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE QuasiQuotes #-}++-- | Test suite.++module Posix (spec) where++import Control.Applicative+import Control.Monad+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Maybe+import Path+import Path.Internal+import Test.Hspec++-- | Test suite (Posix version).+spec :: Spec+spec =+ do describe "Parsing: Path Abs Dir" parseAbsDirSpec+ describe "Parsing: Path Rel Dir" parseRelDirSpec+ describe "Parsing: Path Abs File" parseAbsFileSpec+ describe "Parsing: Path Rel File" parseRelFileSpec+ describe "Operations: (</>)" operationAppend+ describe "Operations: stripDir" operationStripDir+ describe "Operations: isParentOf" operationIsParentOf+ describe "Operations: parent" operationParent+ describe "Operations: filename" operationFilename+ describe "Operations: dirname" operationDirname+ describe "Restrictions" restrictions+ describe "Aeson Instances" aesonInstances+ describe "QuasiQuotes" quasiquotes++-- | Restricting the input of any tricks.+restrictions :: Spec+restrictions =+ do -- These ~ related ones below are now lifted:+ -- https://github.com/chrisdone/path/issues/19+ parseSucceeds "~/" (Path "~/")+ parseSucceeds "~/foo" (Path "~/foo/")+ parseSucceeds "~/foo/bar" (Path "~/foo/bar/")+ parseSucceeds "a.." (Path "a../")+ parseSucceeds "..a" (Path "..a/")+ --+ parseFails "../"+ parseFails ".."+ parseFails "."+ parseFails "/.."+ parseFails "/foo/../bar/"+ parseFails "/foo/bar/.."+ where parseFails x =+ it (show x ++ " should be rejected")+ (isNothing (void (parseAbsDir x) <|>+ void (parseRelDir x) <|>+ void (parseAbsFile x) <|>+ void (parseRelFile x)))+ parseSucceeds x with =+ parserTest parseRelDir x (Just with)++-- | The 'dirname' operation.+operationDirname :: Spec+operationDirname = do+ it+ "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"+ (dirname ($(mkAbsDir "/home/chris/") </> $(mkRelDir "bar")) ==+ dirname $(mkRelDir "bar"))+ it+ "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"+ (dirname ($(mkRelDir "home/chris/") </> $(mkRelDir "bar")) ==+ dirname $(mkRelDir "bar"))++-- | The 'filename' operation.+operationFilename :: Spec+operationFilename =+ do it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"+ (filename ($(mkAbsDir "/home/chris/") </>+ $(mkRelFile "bar.txt")) ==+ filename $(mkRelFile "bar.txt"))++ it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"+ (filename ($(mkRelDir "home/chris/") </>+ $(mkRelFile "bar.txt")) ==+ filename $(mkRelFile "bar.txt"))++-- | The 'parent' operation.+operationParent :: Spec+operationParent =+ do it "parent (parent </> child) == parent"+ (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+ $(mkAbsDir "///bar/")+ ($(mkAbsDir "///bar/") </>+ $(mkRelFile "bar/foo.txt")))++ it "isParentOf parent (parent </> child) (unit test)"+ (isParentOf+ $(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/")+ ($(mkAbsDir "///bar/") </>+ $(mkRelFile "bar/foo.txt")) ==+ Just $(mkRelFile "bar/foo.txt"))++ it "stripDir parent (parent </> child) = child (unit test)"+ (stripDir $(mkRelDir "bar/")+ ($(mkRelDir "bar/") </>+ $(mkRelFile "bob/foo.txt")) ==+ Just $(mkRelFile "bob/foo.txt"))++ it "stripDir parent parent = _|_"+ (stripDir $(mkAbsDir "/home/chris/foo")+ $(mkAbsDir "/home/chris/foo") ==+ Nothing)++-- | The '</>' operation.+operationAppend :: Spec+operationAppend =+ do it "AbsDir + RelDir = AbsDir"+ ($(mkAbsDir "/home/") </>+ $(mkRelDir "chris") ==+ $(mkAbsDir "/home/chris/"))+ it "AbsDir + RelFile = AbsFile"+ ($(mkAbsDir "/home/") </>+ $(mkRelFile "chris/test.txt") ==+ $(mkAbsFile "/home/chris/test.txt"))+ it "RelDir + RelDir = RelDir"+ ($(mkRelDir "home/") </>+ $(mkRelDir "chris") ==+ $(mkRelDir "home/chris"))+ it "RelDir + RelFile = RelFile"+ ($(mkRelDir "home/") </>+ $(mkRelFile "chris/test.txt") ==+ $(mkRelFile "home/chris/test.txt"))++-- | Tests for the tokenizer.+parseAbsDirSpec :: Spec+parseAbsDirSpec =+ do failing ""+ failing "./"+ failing "foo.txt"+ succeeding "/" (Path "/")+ succeeding "//" (Path "/")+ succeeding "///foo//bar//mu/" (Path "/foo/bar/mu/")+ succeeding "///foo//bar////mu" (Path "/foo/bar/mu/")+ succeeding "///foo//bar/.//mu" (Path "/foo/bar/mu/")++ where failing x = parserTest parseAbsDir x Nothing+ succeeding x with = parserTest parseAbsDir x (Just with)++-- | Tests for the tokenizer.+parseRelDirSpec :: Spec+parseRelDirSpec =+ do failing ""+ failing "/"+ failing "//"+ succeeding "~/" (Path "~/") -- https://github.com/chrisdone/path/issues/19+ failing "/"+ failing "./"+ failing "././"+ failing "//"+ failing "///foo//bar//mu/"+ failing "///foo//bar////mu"+ failing "///foo//bar/.//mu"+ succeeding "..." (Path ".../")+ succeeding "foo.bak" (Path "foo.bak/")+ succeeding "./foo" (Path "foo/")+ succeeding "././foo" (Path "foo/")+ succeeding "./foo/./bar" (Path "foo/bar/")+ succeeding "foo//bar//mu//" (Path "foo/bar/mu/")+ succeeding "foo//bar////mu" (Path "foo/bar/mu/")+ succeeding "foo//bar/.//mu" (Path "foo/bar/mu/")++ where failing x = parserTest parseRelDir x Nothing+ succeeding x with = parserTest parseRelDir x (Just with)++-- | Tests for the tokenizer.+parseAbsFileSpec :: Spec+parseAbsFileSpec =+ do failing ""+ failing "./"+ failing "/."+ failing "/foo/bar/."+ failing "~/"+ failing "./foo.txt"+ failing "/"+ failing "//"+ failing "///foo//bar//mu/"+ succeeding "/..." (Path "/...")+ succeeding "/foo.txt" (Path "/foo.txt")+ succeeding "///foo//bar////mu.txt" (Path "/foo/bar/mu.txt")+ succeeding "///foo//bar/.//mu.txt" (Path "/foo/bar/mu.txt")++ where failing x = parserTest parseAbsFile x Nothing+ succeeding x with = parserTest parseAbsFile x (Just with)++-- | Tests for the tokenizer.+parseRelFileSpec :: Spec+parseRelFileSpec =+ do failing ""+ failing "/"+ failing "//"+ failing "~/"+ failing "/"+ failing "./"+ failing "a/."+ failing "a/../b"+ failing "a/.."+ failing "../foo.txt"+ failing "//"+ failing "///foo//bar//mu/"+ failing "///foo//bar////mu"+ failing "///foo//bar/.//mu"+ succeeding "a.." (Path "a..")+ succeeding "..." (Path "...")+ succeeding "foo.txt" (Path "foo.txt")+ succeeding "./foo.txt" (Path "foo.txt")+ succeeding "././foo.txt" (Path "foo.txt")+ succeeding "./foo/./bar.txt" (Path "foo/bar.txt")+ succeeding "foo//bar//mu.txt" (Path "foo/bar/mu.txt")+ succeeding "foo//bar////mu.txt" (Path "foo/bar/mu.txt")+ succeeding "foo//bar/.//mu.txt" (Path "foo/bar/mu.txt")++ where failing x = parserTest parseRelFile x Nothing+ succeeding x with = parserTest parseRelFile x (Just with)++-- | Parser test.+parserTest :: (Show a1,Show a,Eq a1)+ => (a -> Maybe a1) -> a -> Maybe a1 -> SpecWith ()+parserTest parser input expected =+ it ((case expected of+ Nothing -> "Failing: "+ Just{} -> "Succeeding: ") +++ "Parsing " +++ show input +++ " " +++ case expected of+ Nothing -> "should fail."+ Just x -> "should succeed with: " ++ show x)+ (actual `shouldBe` expected)+ where actual = parser input++-- | Tests for the 'ToJSON' and 'FromJSON' instances+--+-- Can't use overloaded strings due to some weird issue with bytestring-0.9.2.1 / ghc-7.4.2:+-- https://travis-ci.org/sjakobi/path/jobs/138399072#L989+aesonInstances :: Spec+aesonInstances =+ do it "Decoding \"[\"/foo/bar\"]\" as a [Path Abs Dir] should succeed." $+ eitherDecode (LBS.pack "[\"/foo/bar\"]") `shouldBe` Right [Path "/foo/bar/" :: Path Abs Dir]+ it "Decoding \"[\"/foo/bar\"]\" as a [Path Rel Dir] should fail." $+ decode (LBS.pack "[\"/foo/bar\"]") `shouldBe` (Nothing :: Maybe [Path Rel Dir])+ it "Encoding \"[\"/foo/bar/mu.txt\"]\" should succeed." $+ encode [Path "/foo/bar/mu.txt" :: Path Abs File] `shouldBe` (LBS.pack "[\"/foo/bar/mu.txt\"]")++-- | Test QuasiQuoters. Make sure they work the same as the $(mk*) constructors.+quasiquotes :: Spec+quasiquotes =+ do it "[absdir|/|] == $(mkAbsDir \"/\")"+ ([absdir|/|] `shouldBe` $(mkAbsDir "/"))+ it "[absdir|/home|] == $(mkAbsDir \"/home\")"+ ([absdir|/home|] `shouldBe` $(mkAbsDir "/home"))+ it "[reldir|foo|] == $(mkRelDir \"foo\")"+ ([reldir|foo|] `shouldBe` $(mkRelDir "foo"))+ it "[reldir|foo/bar|] == $(mkRelDir \"foo/bar\")"+ ([reldir|foo/bar|] `shouldBe` $(mkRelDir "foo/bar"))+ it "[absfile|/home/chris/foo.txt|] == $(mkAbsFile \"/home/chris/foo.txt\")"+ ([absfile|/home/chris/foo.txt|] `shouldBe` $(mkAbsFile "/home/chris/foo.txt"))+ it "[relfile|foo|] == $(mkRelFile \"foo\")"+ ([relfile|foo|] `shouldBe` $(mkRelFile "foo"))+ it "[relfile|chris/foo.txt|] == $(mkRelFile \"chris/foo.txt\")"+ ([relfile|chris/foo.txt|] `shouldBe` $(mkRelFile "chris/foo.txt"))
test/ValidityTest.hs view
@@ -17,7 +17,7 @@ import Test.QuickCheck import Test.Validity -import Path.Gen ()+import Path.Gen -- | Test suite entry point, returns exit failure if any test fails. main :: IO ()@@ -25,11 +25,11 @@ -- | Test suite. spec :: Spec-spec = do- describe "Parsing: Path Abs Dir" parseAbsDirSpec- describe "Parsing: Path Rel Dir" parseRelDirSpec- describe "Parsing: Path Abs File" parseAbsFileSpec- describe "Parsing: Path Rel File" parseRelFileSpec+spec = parallel $ do+ describe "Parsing: Path Abs Dir" (parserSpec parseAbsDir)+ describe "Parsing: Path Rel Dir" (parserSpec parseRelDir)+ 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@@ -40,13 +40,13 @@ operationFilename :: Spec operationFilename = do it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $- forAll genValid $ \(parent :: Path Abs Dir) ->- forAll genValid $ \file ->+ forAllShrink genValid shrinkValidAbsDir $ \parent ->+ forAllShrink genValid shrinkValidRelFile $ \file -> filename (parent </> file) `shouldBe` filename file it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename)" $- forAll genValid $ \(parent :: Path Rel Dir) ->- forAll genValid $ \file ->+ forAllShrink genValid shrinkValidRelDir $ \parent ->+ forAllShrink genValid shrinkValidRelFile $ \file -> filename (parent </> file) `shouldBe` filename file it "produces a valid path on when passed a valid absolute path" $ do@@ -68,48 +68,48 @@ operationIsParentOf :: Spec operationIsParentOf = do it "isParentOf parent (parent </> child)" $- forAll genValid $ \(parent :: Path Abs Dir) ->- forAll genValid $ \(child :: Path Rel File) ->+ forAllShrink genValid shrinkValidAbsDir $ \parent ->+ forAllShrink genValid shrinkValidRelFile $ \child -> isParentOf parent (parent </> child) it "isParentOf parent (parent </> child)" $- forAll genValid $ \(parent :: Path Abs Dir) ->- forAll genValid $ \(child :: Path Rel Dir) ->+ forAllShrink genValid shrinkValidAbsDir $ \parent ->+ forAllShrink genValid shrinkValidRelDir $ \child -> isParentOf parent (parent </> child) it "isParentOf parent (parent </> child)" $- forAll genValid $ \(parent :: Path Rel Dir) ->- forAll genValid $ \(child :: Path Rel File) ->+ forAllShrink genValid shrinkValidRelDir $ \parent ->+ forAllShrink genValid shrinkValidRelFile $ \child -> isParentOf parent (parent </> child) it "isParentOf parent (parent </> child)" $- forAll genValid $ \(parent :: Path Rel Dir) ->- forAll genValid $ \(child :: Path Rel Dir) ->+ forAllShrink genValid shrinkValidRelDir $ \parent ->+ forAllShrink genValid shrinkValidRelDir $ \child -> isParentOf parent (parent </> child) -- | The 'stripDir' operation. operationStripDir :: Spec operationStripDir = do it "stripDir parent (parent </> child) = child" $- forAll genValid $ \(parent :: Path Abs Dir) ->- forAll genValid $ \(child :: Path Rel File) ->+ forAllShrink genValid shrinkValidAbsDir $ \parent ->+ forAllShrink genValid shrinkValidRelFile $ \child -> stripDir parent (parent </> child) == Just child it "stripDir parent (parent </> child) = child" $- forAll genValid $ \(parent :: Path Rel Dir) ->- forAll genValid $ \(child :: Path Rel File) ->+ forAllShrink genValid shrinkValidRelDir $ \parent ->+ forAllShrink genValid shrinkValidRelFile $ \child -> stripDir parent (parent </> child) == Just child it "stripDir parent (parent </> child) = child" $- forAll genValid $ \(parent :: Path Abs Dir) ->- forAll genValid $ \(child :: Path Rel Dir) ->+ forAllShrink genValid shrinkValidAbsDir $ \parent ->+ forAllShrink genValid shrinkValidRelDir $ \child -> stripDir parent (parent </> child) == Just child it "stripDir parent (parent </> child) = child" $- forAll genValid $ \(parent :: Path Rel Dir) ->- forAll genValid $ \(child :: Path Rel Dir) ->+ forAllShrink genValid shrinkValidRelDir $ \parent ->+ forAllShrink genValid shrinkValidRelDir $ \child -> stripDir parent (parent </> child) == Just child- + it "produces a valid path on when passed a valid absolute file paths" $ do producesValidsOnValids2 (stripDir @Maybe @Abs @File) @@ -137,27 +137,7 @@ it "produces a valid path on when creating valid relative directory paths" $ do producesValidsOnValids2 ((</>) @Rel @Dir) --parseAbsDirSpec :: Spec-parseAbsDirSpec = do- it "Produces valid paths when it succeeds" $- validIfSucceedsOnArbitrary- (parseAbsDir @Maybe)--parseRelDirSpec :: Spec-parseRelDirSpec = do- it "Produces valid paths when it succeeds" $- validIfSucceedsOnArbitrary- (parseRelDir @Maybe)--parseAbsFileSpec :: Spec-parseAbsFileSpec = do- it "Produces valid paths when it succeeds" $- validIfSucceedsOnArbitrary- (parseAbsFile @Maybe)--parseRelFileSpec :: Spec-parseRelFileSpec = do+parserSpec :: (Show p, Validity p) => (FilePath -> Maybe p) -> Spec+parserSpec parser = it "Produces valid paths when it succeeds" $- validIfSucceedsOnArbitrary- (parseRelFile @Maybe)+ validIfSucceedsOnGen parser genFilePath
+ test/Windows.hs view
@@ -0,0 +1,285 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE QuasiQuotes #-}++-- | Test suite.++module Windows (spec) where++import Control.Applicative+import Control.Monad+import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as LBS+import Data.Maybe+import Path+import Path.Internal+import Test.Hspec++-- | Test suite (Windows version).+spec :: Spec+spec =+ do describe "Parsing: Path Abs Dir" parseAbsDirSpec+ describe "Parsing: Path Rel Dir" parseRelDirSpec+ describe "Parsing: Path Abs File" parseAbsFileSpec+ describe "Parsing: Path Rel File" parseRelFileSpec+ describe "Operations: (</>)" operationAppend+ describe "Operations: stripDir" operationStripDir+ describe "Operations: isParentOf" operationIsParentOf+ describe "Operations: parent" operationParent+ describe "Operations: filename" operationFilename+ describe "Operations: dirname" operationDirname+ describe "Restrictions" restrictions+ describe "Aeson Instances" aesonInstances+ describe "QuasiQuotes" quasiquotes++-- | Restricting the input of any tricks.+restrictions :: Spec+restrictions =+ do parseFails "..\\"+ parseFails ".."+ parseFails "."+ parseSucceeds "a.." (Path "a..\\")+ parseSucceeds "..a" (Path "..a\\")+ parseFails "\\.."+ parseFails "C:\\foo\\..\\bar\\"+ parseFails "C:\\foo\\bar\\.."+ where parseFails x =+ it (show x ++ " should be rejected")+ (isNothing (void (parseAbsDir x) <|>+ void (parseRelDir x) <|>+ void (parseAbsFile x) <|>+ void (parseRelFile x)))+ parseSucceeds x with =+ parserTest parseRelDir x (Just with)++-- | The 'dirname' operation.+operationDirname :: Spec+operationDirname = do+ it+ "dirname ($(mkAbsDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"+ (dirname ($(mkAbsDir "C:\\chris\\") </> $(mkRelDir "bar")) ==+ dirname $(mkRelDir "bar"))+ it+ "dirname ($(mkRelDir parent) </> $(mkRelFile dirname)) == dirname $(mkRelFile dirname) (unit test)"+ (dirname ($(mkRelDir "home\\chris\\") </> $(mkRelDir "bar")) ==+ dirname $(mkRelDir "bar"))++-- | The 'filename' operation.+operationFilename :: Spec+operationFilename =+ do it "filename ($(mkAbsDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"+ (filename ($(mkAbsDir "C:\\chris\\") </>+ $(mkRelFile "bar.txt")) ==+ filename $(mkRelFile "bar.txt"))++ it "filename ($(mkRelDir parent) </> $(mkRelFile filename)) == filename $(mkRelFile filename) (unit test)"+ (filename ($(mkRelDir "home\\chris\\") </>+ $(mkRelFile "bar.txt")) ==+ filename $(mkRelFile "bar.txt"))++-- | The 'parent' operation.+operationParent :: Spec+operationParent =+ do it "parent (parent </> child) == parent"+ (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+ $(mkAbsDir "C:\\\\\\bar\\")+ ($(mkAbsDir "C:\\\\\\bar\\") </>+ $(mkRelFile "bar\\foo.txt")))++ it "isParentOf parent (parent </> child) (unit test)"+ (isParentOf+ $(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\\")+ ($(mkAbsDir "C:\\\\\\bar\\") </>+ $(mkRelFile "bar\\foo.txt")) ==+ Just $(mkRelFile "bar\\foo.txt"))++ it "stripDir parent (parent </> child) = child (unit test)"+ (stripDir $(mkRelDir "bar\\")+ ($(mkRelDir "bar\\") </>+ $(mkRelFile "bob\\foo.txt")) ==+ Just $(mkRelFile "bob\\foo.txt"))++ it "stripDir parent parent = _|_"+ (stripDir $(mkAbsDir "C:\\home\\chris\\foo")+ $(mkAbsDir "C:\\home\\chris\\foo") ==+ Nothing)++-- | The '</>' operation.+operationAppend :: Spec+operationAppend =+ do it "AbsDir + RelDir = AbsDir"+ ($(mkAbsDir "C:\\home\\") </>+ $(mkRelDir "chris") ==+ $(mkAbsDir "C:\\home\\chris\\"))+ it "AbsDir + RelFile = AbsFile"+ ($(mkAbsDir "C:\\home\\") </>+ $(mkRelFile "chris\\test.txt") ==+ $(mkAbsFile "C:\\home\\chris\\test.txt"))+ it "RelDir + RelDir = RelDir"+ ($(mkRelDir "home\\") </>+ $(mkRelDir "chris") ==+ $(mkRelDir "home\\chris"))+ it "RelDir + RelFile = RelFile"+ ($(mkRelDir "home\\") </>+ $(mkRelFile "chris\\test.txt") ==+ $(mkRelFile "home\\chris\\test.txt"))++-- | Tests for the tokenizer.+parseAbsDirSpec :: Spec+parseAbsDirSpec =+ do failing ""+ failing ".\\"+ failing "foo.txt"+ succeeding "C:\\" (Path "C:\\")+ succeeding "C:\\\\" (Path "C:\\\\")+ -- succeeding "C:\\\\\\foo\\\\bar\\\\mu\\" (Path "C:\\foo\\bar\\mu\\") FIXME+ -- succeeding "C:\\\\\\foo\\\\bar\\\\mu" (Path "C:\\foo\\bar\\mu\\") FIXME+ -- succeeding "C:\\\\\\foo\\\\bar\\.\\\\mu" (Path "C:\\foo\\bar\\mu\\") FIXME++ where failing x = parserTest parseAbsDir x Nothing+ succeeding x with = parserTest parseAbsDir x (Just with)++-- | Tests for the tokenizer.+parseRelDirSpec :: Spec+parseRelDirSpec =+ do failing ""+ -- failing "/" FIXME+ -- failing "//" FIXME+ -- succeeding "~/" (Path "~/") -- https://github.com/chrisdone/path/issues/19+ -- failing "\\" FIXME+ failing ".\\"+ failing ".\\.\\"+ failing "\\\\"+ failing "\\\\\\foo\\\\bar\\\\mu\\"+ failing "\\\\\\foo\\\\bar\\\\\\\\mu"+ failing "\\\\\\foo\\\\bar\\.\\\\mu"+ succeeding "..." (Path "...\\")+ succeeding "foo.bak" (Path "foo.bak\\")+ succeeding ".\\foo" (Path "foo\\")+ succeeding ".\\.\\foo" (Path "foo\\")+ succeeding ".\\foo\\.\\bar" (Path "foo\\bar\\")+ succeeding "foo\\\\bar\\\\mu\\\\" (Path "foo\\bar\\mu\\")+ succeeding "foo\\\\bar////mu" (Path "foo\\bar\\mu\\")+ succeeding "foo\\\\bar\\.\\\\mu" (Path "foo\\bar\\mu\\")++ where failing x = parserTest parseRelDir x Nothing+ succeeding x with = parserTest parseRelDir x (Just with)++-- | Tests for the tokenizer.+parseAbsFileSpec :: Spec+parseAbsFileSpec =+ do failing ""+ failing ".\\"+ failing "\\."+ failing "\\foo\\bar\\."+ failing "~\\"+ failing ".\\foo.txt"+ failing "\\"+ failing "\\\\"+ failing "\\\\\\foo\\\\bar\\\\mu\\"+ -- succeeding "\\..." (Path "\\...") FIXME+ -- succeeding "\\foo.txt" (Path "\\foo.txt") FIXME+ -- succeeding "C:\\\\\\foo\\\\bar\\\\\\\\mu.txt" (Path "C:\\foo\\bar\\mu.txt") FIXME+ -- succeeding "C:\\\\\\foo\\\\bar\\.\\\\mu.txt" (Path "C:\\foo\\bar\\mu.txt") FIXME++ where failing x = parserTest parseAbsFile x Nothing+ succeeding x with = parserTest parseAbsFile x (Just with)++-- | Tests for the tokenizer.+parseRelFileSpec :: Spec+parseRelFileSpec =+ do failing ""+ failing "\\"+ failing "\\\\"+ failing "~\\"+ failing "\\"+ failing ".\\"+ failing "a\\."+ failing "a\\..\\b"+ failing "a\\.."+ failing "..\\foo.txt"+ failing "\\\\"+ failing "\\\\\\foo\\\\bar\\\\mu\\"+ failing "\\\\\\foo\\\\bar\\\\\\\\mu"+ failing "\\\\\\foo\\\\bar\\.\\\\mu"+ succeeding "a.." (Path "a..")+ succeeding "..." (Path "...")+ succeeding "foo.txt" (Path "foo.txt")+ succeeding ".\\foo.txt" (Path "foo.txt")+ succeeding ".\\.\\foo.txt" (Path "foo.txt")+ succeeding ".\\foo\\.\\bar.txt" (Path "foo\\bar.txt")+ succeeding "foo\\\\bar\\\\mu.txt" (Path "foo\\bar\\mu.txt")+ succeeding "foo\\\\bar\\\\\\\\mu.txt" (Path "foo\\bar\\mu.txt")+ succeeding "foo\\\\bar\\.\\\\mu.txt" (Path "foo\\bar\\mu.txt")++ where failing x = parserTest parseRelFile x Nothing+ succeeding x with = parserTest parseRelFile x (Just with)++-- | Parser test.+parserTest :: (Show a1,Show a,Eq a1)+ => (a -> Maybe a1) -> a -> Maybe a1 -> SpecWith ()+parserTest parser input expected =+ it ((case expected of+ Nothing -> "Failing: "+ Just{} -> "Succeeding: ") +++ "Parsing " +++ show input +++ " " +++ case expected of+ Nothing -> "should fail."+ Just x -> "should succeed with: " ++ show x)+ (actual `shouldBe` expected)+ where actual = parser input++-- | Tests for the 'ToJSON' and 'FromJSON' instances+--+-- Can't use overloaded strings due to some weird issue with bytestring-0.9.2.1 / ghc-7.4.2:+-- https://travis-ci.org/sjakobi/path/jobs/138399072#L989+aesonInstances :: Spec+aesonInstances =+ do it "Decoding \"[\"C:\\\\foo\\\\bar\"]\" as a [Path Abs Dir] should succeed." $+ eitherDecode (LBS.pack "[\"C:\\\\foo\\\\bar\"]") `shouldBe` Right [Path "C:\\foo\\bar\\" :: Path Abs Dir]+ it "Decoding \"[\"C:\\foo\\bar\"]\" as a [Path Rel Dir] should fail." $+ decode (LBS.pack "[\"C:\\foo\\bar\"]") `shouldBe` (Nothing :: Maybe [Path Rel Dir])+ it "Encoding \"[\"C:\\foo\\bar\\mu.txt\"]\" should succeed." $+ encode [Path "C:\\foo\\bar\\mu.txt" :: Path Abs File] `shouldBe` (LBS.pack "[\"C:\\\\foo\\\\bar\\\\mu.txt\"]")++-- | Test QuasiQuoters. Make sure they work the same as the $(mk*) constructors.+quasiquotes :: Spec+quasiquotes =+ do it "[absdir|C:\\|] == $(mkAbsDir \"C:\\\")"+ ([absdir|C:\|] `shouldBe` $(mkAbsDir "C:\\"))+ it "[absdir|C:\\chris\\|] == $(mkAbsDir \"C:\\chris\\\")"+ ([absdir|C:\chris\|] `shouldBe` $(mkAbsDir "C:\\chris\\"))+ it "[reldir|foo|] == $(mkRelDir \"foo\")"+ ([reldir|foo|] `shouldBe` $(mkRelDir "foo"))+ it "[reldir|foo\\bar|] == $(mkRelDir \"foo\\bar\")"+ ([reldir|foo\bar|] `shouldBe` $(mkRelDir "foo\\bar"))+ it "[absfile|C:\\chris\\foo.txt|] == $(mkAbsFile \"C:\\chris\\foo.txt\")"+ ([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\")"+ ([relfile|chris\foo.txt|] `shouldBe` $(mkRelFile "chris\\foo.txt"))