path-0.5.3/src/0000755000000000000000000000000012624136666011444 5ustar0000000000000000path-0.5.3/src/Path/0000755000000000000000000000000012624136666012340 5ustar0000000000000000path-0.5.3/test/0000755000000000000000000000000012624136666011634 5ustar0000000000000000path-0.5.3/src/Path.hs0000644000000000000000000002222412624136666012676 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} -- | A normalizing well-typed path type. module Path (-- * Types Path ,Abs ,Rel ,File ,Dir -- * Parsing ,parseAbsDir ,parseRelDir ,parseAbsFile ,parseRelFile ,PathParseException -- * Constructors ,mkAbsDir ,mkRelDir ,mkAbsFile ,mkRelFile -- * Operations ,() ,stripDir ,isParentOf ,parent ,filename ,dirname -- * Conversion ,toFilePath ,fromAbsDir ,fromRelDir ,fromAbsFile ,fromRelFile ) where import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow(..)) import Data.Data import Data.List import Data.Maybe import Language.Haskell.TH import Path.Internal import qualified System.FilePath as FilePath -------------------------------------------------------------------------------- -- Types -- | An absolute path. data Abs deriving (Typeable) -- | A relative path; one without a root. data Rel deriving (Typeable) -- | A file path. data File deriving (Typeable) -- | A directory path. data Dir deriving (Typeable) -- | Exception when parsing a location. data PathParseException = InvalidAbsDir FilePath | InvalidRelDir FilePath | InvalidAbsFile FilePath | InvalidRelFile FilePath | Couldn'tStripPrefixDir FilePath FilePath deriving (Show,Typeable) instance Exception PathParseException -------------------------------------------------------------------------------- -- Parsers -- | Get a location for an absolute directory. Produces a normalized -- path which always ends in a path separator. -- -- Throws: 'PathParseException' -- parseAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir) parseAbsDir filepath = if FilePath.isAbsolute filepath && not (null (normalizeDir filepath)) && not ("~/" `isPrefixOf` filepath) && not (hasParentDir 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. -- -- Throws: 'PathParseException' -- 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 /= ".." then return (Path (normalizeDir filepath)) else throwM (InvalidRelDir filepath) -- | Get a location for an absolute file. -- -- Throws: 'PathParseException' -- 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 /= ".." then return (Path (normalizeFile filepath)) else throwM (InvalidAbsFile filepath) -- | Get a location for a relative file. -- -- Throws: 'PathParseException' -- parseRelFile :: MonadThrow m => FilePath -> m (Path Rel File) parseRelFile filepath = if not (FilePath.isAbsolute filepath || FilePath.hasTrailingPathSeparator filepath) && not (null filepath) && not ("~/" `isPrefixOf` filepath) && not (hasParentDir filepath) && not (null (normalizeFile filepath)) && filepath /= ".." then return (Path (normalizeFile filepath)) else throwM (InvalidRelFile 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' -------------------------------------------------------------------------------- -- Constructors -- | 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 -- platform (Windows). mkAbsDir :: FilePath -> Q Exp mkAbsDir s = case parseAbsDir s of Left err -> error (show err) Right (Path str) -> [|Path $(return (LitE (StringL str))) :: Path Abs Dir|] -- | Make a 'Path Rel Dir'. mkRelDir :: FilePath -> Q Exp mkRelDir s = case parseRelDir s of Left err -> error (show err) Right (Path str) -> [|Path $(return (LitE (StringL str))) :: Path Rel Dir|] -- | 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 -- platform (Windows). mkAbsFile :: FilePath -> Q Exp mkAbsFile s = case parseAbsFile s of Left err -> error (show err) Right (Path str) -> [|Path $(return (LitE (StringL str))) :: Path Abs File|] -- | Make a 'Path Rel File'. mkRelFile :: FilePath -> Q Exp mkRelFile s = case parseRelFile s of Left err -> error (show err) 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. -- Returns 'Nothing' 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. -- -- Throws: 'Couldn'tStripPrefixDir' -- 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. 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 (normalizeFile (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)) -------------------------------------------------------------------------------- -- Internal functions -- | Internal use for normalizing a directory. normalizeDir :: FilePath -> FilePath normalizeDir = clean . FilePath.addTrailingPathSeparator . FilePath.normalise where clean "./" = "" clean ('/':'/':xs) = clean ('/':xs) clean x = x -- | Internal use for normalizing a fileectory. normalizeFile :: FilePath -> FilePath normalizeFile = clean . FilePath.normalise where clean "./" = "" clean ('/':'/':xs) = clean ('/':xs) clean x = x path-0.5.3/src/Path/Internal.hs0000644000000000000000000000202512624136666014447 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | Internal types and functions. module Path.Internal (Path(..)) where import Data.Data -- | Path of some base and type. -- -- Internally is a string. The string can be of two formats only: -- -- 1. File format: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@ -- 2. Directory format: @foo\/@, @\/foo\/bar\/@ -- -- All directories end in a trailing separator. There are no duplicate -- path separators @\/\/@, no @..@, no @.\/@, no @~\/@, etc. newtype Path b t = Path FilePath deriving (Typeable) -- | String equality. -- -- The following property holds: -- -- @show x == show y ≡ x == y@ instance Eq (Path b t) where (==) (Path x) (Path y) = x == y -- | String ordering. -- -- The following property holds: -- -- @show x \`compare\` show y ≡ x \`compare\` y@ instance Ord (Path b t) where compare (Path x) (Path y) = compare x y -- | Same as 'Path.toFilePath'. -- -- The following property holds: -- -- @x == y ≡ show x == show y@ instance Show (Path b t) where show (Path x) = show x path-0.5.3/test/Main.hs0000644000000000000000000001554412624136666013065 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | Test suite. module Main where import Control.Applicative import Control.Monad import Data.Maybe import Data.Monoid import Path import Path.Internal import Test.Hspec -- | 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 "Restrictions" restrictions -- | Restricting the input of any tricks. restrictions :: Spec restrictions = do parseFails "~/" parseFails "~/foo" parseFails "~/foo/bar" 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))) -- | The 'filename' operation. operationFilename :: Spec operationFilename = do it "filename ($(mkAbsDir parent) filename $(mkRelFile filename)) == $(mkRelFile filename)" (filename ($(mkAbsDir "/home/chris/") filename $(mkRelFile "bar.txt")) == $(mkRelFile "bar.txt")) it "filename ($(mkRelDir parent) filename $(mkRelFile filename)) == $(mkRelFile filename)" (filename ($(mkRelDir "home/chris/") filename $(mkRelFile "bar.txt")) == $(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)" (isParentOf $(mkAbsDir "///bar/") ($(mkAbsDir "///bar/") $(mkRelFile "bar/foo.txt"))) it "isParentOf parent (parent child)" (isParentOf $(mkRelDir "bar/") ($(mkRelDir "bar/") $(mkRelFile "bob/foo.txt"))) -- | The 'stripDir' operation. operationStripDir :: Spec operationStripDir = do it "stripDir parent (parent child) = child" (stripDir $(mkAbsDir "///bar/") ($(mkAbsDir "///bar/") $(mkRelFile "bar/foo.txt")) == Just $(mkRelFile "bar/foo.txt")) it "stripDir parent (parent child) = child" (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 "~/" 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 "//" failing "~/" failing "/" failing "./" failing "//" failing "///foo//bar//mu/" failing "///foo//bar////mu" failing "///foo//bar/.//mu" succeeding "foo.bak" (Path "foo.bak/") succeeding "./foo" (Path "foo/") 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.txt" failing "/" failing "//" failing "///foo//bar//mu/" 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 "//" failing "///foo//bar//mu/" failing "///foo//bar////mu" failing "///foo//bar/.//mu" succeeding "foo.txt" (Path "foo.txt") 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") 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 == expected) where actual = parser input path-0.5.3/LICENSE0000644000000000000000000000271512624136666011667 0ustar0000000000000000Copyright (c) 2015, FP Complete All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of paths nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. path-0.5.3/Setup.hs0000644000000000000000000000005612624136666012312 0ustar0000000000000000import Distribution.Simple main = defaultMain path-0.5.3/path.cabal0000644000000000000000000000167412624136733012600 0ustar0000000000000000name: path version: 0.5.3 synopsis: Path description: Path license: BSD3 license-file: LICENSE author: Chris Done maintainer: chrisdone@fpcomplete.com copyright: 2015 FP Complete category: Filesystem build-type: Simple cabal-version: >=1.8 extra-source-files: README.md, CHANGELOG library hs-source-dirs: src/ ghc-options: -Wall -O2 exposed-modules: Path, Path.Internal build-depends: base >= 4 && <5 , exceptions , filepath , template-haskell test-suite test type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test build-depends: HUnit , base , hspec , mtl , path source-repository head type: git location: https://github.com/chrisdone/path.git path-0.5.3/README.md0000644000000000000000000000006512624136666012135 0ustar0000000000000000path ===== Support for well-typed paths in Haskell. path-0.5.3/CHANGELOG0000644000000000000000000000051712624136772012070 0ustar00000000000000000.5.3: * Added conversion functions. 0.2.0: * Rename parentAbs to simply parent. * Add dirname. 0.3.0: * Removed Generic instance. 0.4.0: * Implemented stricter parsing, disabling use of "..". * Made stripDir generic over MonadThrow 0.5.0: * Fix stripDir p p /= Nothing bug. 0.5.2: * Removed unused DeriveGeneric.