path 0.5.8 → 0.5.9
raw patch · 4 files changed
+82/−51 lines, 4 filesdep +bytestringdep ~filepath
Dependencies added: bytestring
Dependency ranges changed: filepath
Files
- CHANGELOG +2/−0
- path.cabal +4/−3
- src/Path.hs +59/−38
- test/Main.hs +17/−10
CHANGELOG view
@@ -1,3 +1,5 @@+0.5.9:+ * Lifted ~ restriction from parser https://github.com/chrisdone/path/issues/19 0.5.8 * Add Aeson instances.
path.cabal view
@@ -1,7 +1,7 @@ name: path-version: 0.5.8+version: 0.5.9 synopsis: Support for well-typed paths-description: Support for will-typed paths.+description: Support for well-typed paths. license: BSD3 license-file: LICENSE author: Chris Done <chrisdone@fpcomplete.com>@@ -18,7 +18,7 @@ exposed-modules: Path, Path.Internal build-depends: base >= 4 && <5 , exceptions- , filepath+ , filepath < 1.2.0.1 || >= 1.3 , template-haskell , deepseq , aeson@@ -30,6 +30,7 @@ build-depends: HUnit , aeson , base+ , bytestring , hspec , mtl , path
src/Path.hs view
@@ -9,6 +9,7 @@ -- -- Support for well-typed paths. +{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-}@@ -65,7 +66,10 @@ -- | An absolute path. data Abs deriving (Typeable) --- | A relative path; one without a root.+-- | 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. data Rel deriving (Typeable) -- | A file path.@@ -112,63 +116,72 @@ -------------------------------------------------------------------------------- -- Parsers --- | Get a location for an absolute directory. Produces a normalized--- path which always ends in a path separator.+-- | Convert an absolute 'FilePath' to a normalized absolute dir 'Path'. ----- Throws: 'PathParseException'+-- Throws: 'PathParseException' when the supplied path: --+-- * is not an absolute path+-- * contains a @..@ anywhere in the path+-- * is not a valid path (See 'System.FilePath.isValid')+-- parseAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir) parseAbsDir filepath = if FilePath.isAbsolute filepath &&- not (null (normalizeDir filepath)) &&- not ("~/" `isPrefixOf` filepath) && not (hasParentDir filepath) && FilePath.isValid filepath then return (Path (normalizeDir filepath)) else throwM (InvalidAbsDir filepath) --- | Get a location for a relative directory. Produces a normalized--- path which always ends in a path separator.+-- | Convert a relative 'FilePath' to a normalized relative dir 'Path'. ----- Note that @filepath@ may contain any number of @./@ but may not consist solely of @./@. It also may not contain a single @..@ anywhere.+-- Throws: 'PathParseException' when the supplied path: ----- Throws: 'PathParseException'+-- * is not a relative path+-- * is any of @""@, @.@ or @..@+-- * contains @..@ anywhere in the path+-- * is not a valid path (See 'System.FilePath.isValid') -- parseRelDir :: MonadThrow m => FilePath -> m (Path Rel Dir) parseRelDir filepath = if not (FilePath.isAbsolute filepath) &&- not (null filepath) &&- not ("~/" `isPrefixOf` filepath) && not (hasParentDir filepath) &&- not (null (normalizeDir filepath)) &&- filepath /= "." && filepath /= ".." &&+ not (null filepath) &&+ filepath /= "." && (normalizeFilePath filepath) /= curDirNormalizedFP &&+ filepath /= ".." && FilePath.isValid filepath then return (Path (normalizeDir filepath)) else throwM (InvalidRelDir filepath) --- | Get a location for an absolute file.+-- | Convert an absolute 'FilePath' to a normalized absolute file 'Path'. ----- Throws: 'PathParseException'+-- Throws: 'PathParseException' when the supplied path: --+-- * is not an absolute path+-- * has a trailing path separator+-- * contains @..@ anywhere in the path+-- * is not a valid path (See 'System.FilePath.isValid')+-- parseAbsFile :: MonadThrow m => FilePath -> m (Path Abs File) parseAbsFile filepath = if FilePath.isAbsolute filepath && not (FilePath.hasTrailingPathSeparator filepath) &&- not ("~/" `isPrefixOf` filepath) && not (hasParentDir filepath) &&- not (null (normalizeFile filepath)) && FilePath.isValid filepath- then return (Path (normalizeFile filepath))+ then return (Path (normalizeFilePath filepath)) else throwM (InvalidAbsFile filepath) --- | Get a location for a relative file.+-- | Convert a relative 'FilePath' to a normalized relative file 'Path'. ----- Note that @filepath@ may contain any number of @./@ but may not contain a single @..@ anywhere.+-- Throws: 'PathParseException' when the supplied path: ----- Throws: 'PathParseException'+-- * is not a relative path+-- * has a trailing path separator+-- * is @""@, @.@ or @..@+-- * contains @..@ anywhere in the path+-- * is not a valid path (See 'System.FilePath.isValid') -- parseRelFile :: MonadThrow m => FilePath -> m (Path Rel File)@@ -176,12 +189,10 @@ if not (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) && not (null filepath) &&- not ("~/" `isPrefixOf` filepath) && not (hasParentDir filepath) &&- not (null (normalizeFile filepath)) && filepath /= "." && filepath /= ".." && FilePath.isValid filepath- then return (Path (normalizeFile filepath))+ then return (Path (normalizeFilePath filepath)) else throwM (InvalidRelFile filepath) -- | Helper function: check if the filepath has any parent directories in it.@@ -320,6 +331,13 @@ -- | 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)@@ -346,7 +364,7 @@ -- filename :: Path b File -> Path Rel File filename (Path l) =- Path (normalizeFile (FilePath.takeFileName l))+ Path (FilePath.takeFileName l) -- | Extract the last directory name of a path. --@@ -361,18 +379,21 @@ -------------------------------------------------------------------------------- -- Internal functions +curDirNormalizedFP :: FilePath+curDirNormalizedFP = '.' : [FilePath.pathSeparator]+ -- | Internal use for normalizing a directory. normalizeDir :: FilePath -> FilePath-normalizeDir =- clean . FilePath.addTrailingPathSeparator . FilePath.normalise- where clean "./" = ""- clean ('/':'/':xs) = clean ('/':xs)- clean x = x+normalizeDir = FilePath.addTrailingPathSeparator . normalizeFilePath --- | Internal use for normalizing a fileectory.-normalizeFile :: FilePath -> FilePath-normalizeFile =- clean . FilePath.normalise- where clean "./" = ""- clean ('/':'/':xs) = clean ('/':xs)- clean x = x+normalizeFilePath :: FilePath -> FilePath+#if defined(mingw32_HOST_OS) || defined(__MINGW32__) || MIN_VERSION_filepath(1,4,0)+normalizeFilePath = FilePath.normalise+#else+normalizeFilePath = normalizeLeadingSeparators . FilePath.normalise+ where+ sep = FilePath.pathSeparator+ normalizeLeadingSeparators (x1:x2:xs) | x1 == sep && x2 == sep+ = normalizeLeadingSeparators (sep:xs)+ normalizeLeadingSeparators x = x+#endif
test/Main.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-} -- | Test suite. @@ -8,6 +7,7 @@ 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@@ -35,9 +35,12 @@ -- | Restricting the input of any tricks. restrictions :: Spec restrictions =- do parseFails "~/"- parseFails "~/foo"- parseFails "~/foo/bar"+ 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 "."@@ -50,6 +53,8 @@ void (parseRelDir x) <|> void (parseAbsFile x) <|> void (parseRelFile x)))+ parseSucceeds x with =+ parserTest parseRelDir x (Just with) -- | The 'filename' operation. operationFilename :: Spec@@ -134,7 +139,6 @@ parseAbsDirSpec = do failing "" failing "./"- failing "~/" failing "foo.txt" succeeding "/" (Path "/") succeeding "//" (Path "/")@@ -150,7 +154,7 @@ do failing "" failing "/" failing "//"- failing "~/"+ succeeding "~/" (Path "~/") -- https://github.com/chrisdone/path/issues/19 failing "/" failing "./" failing "././"@@ -223,15 +227,18 @@ case expected of Nothing -> "should fail." Just x -> "should succeed with: " ++ show x)- (actual == expected)+ (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 "[\"/foo/bar\"]" `shouldBe` Right [Path "/foo/bar/" :: Path Abs Dir]+ 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 "[\"/foo/bar\"]" `shouldBe` (Nothing :: Maybe [Path Rel Dir])+ 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` "[\"/foo/bar/mu.txt\"]"+ encode [Path "/foo/bar/mu.txt" :: Path Abs File] `shouldBe` (LBS.pack "[\"/foo/bar/mu.txt\"]")