From d15e4b8ad9d05aaa61a492e587f1542029d1b20c Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 8 Mar 2016 22:53:42 +0100 Subject: [PATCH] Fork chrisdone's path library I wasn't happy with the way it dealt with Dir vs File things. In his version of the library, a `Path b Dir` always ends with a trailing path separator and `Path b File` never ends with a trailing path separator. IMO, it is nonsensical to make a Dir vs File distinction on path level, although it first seems nice. Some of the reasons are: * a path is just that: a path. It is completely disconnected from IO level and even if a `Dir`/`File` type theoretically allows us to say "this path ought to point to a file", there is literally zero guarantee that it will hold true at runtime. So this basically gives a false feeling of a type-safe file distinction. * it's imprecise about Dir vs File distinction, which makes it even worse, because a directory is also a file (just not a regular file). Add symlinks to that and the confusion is complete. * it makes the API oddly complicated for use cases where we basically don't care (yet) whether something turns out to be a directory or not Still, it comes also with a few perks: * it simplifies some functions, because they now have guarantees whether a path ends in a trailing path separator or not * it may be safer for interaction with other library functions, which behave differently depending on a trailing path separator (like probably shelly) Not limited to, but also in order to fix my remarks without breaking any benefits, I did: * rename the `Dir`/`File` types to `TPS`/`NoTPS`, so it's clear we are only giving information about trailing path separators and not actual file types we don't know about yet * add a `MaybeTPS` type, which does not mess with trailing path separators and also gives no guarantees about them... then added `toNoTPS` and `toTPS` to allow type-safe conversion * make some functions accept more general types, so we don't unnecessarily force paths with trailing separators for `()` for example... instead these functions now examine the paths to still have correct behavior. This is really minor overhead. You might say now "but then I can append filepath to filepath". Well, as I said... we don't know whether it's a "filepath" at all. * merge `filename` and `dirname` into `basename` and make `parent` be `dirname`, so the function names match the name of the POSIX ones, which do (almost) the same... * fix a bug in `basename` (formerly `dirname`) which broke the type guarantees * add a pattern synonym for easier pattern matching without exporting the internal Path constructor --- .gitignore | 2 + CHANGELOG | 2 + LICENSE | 1 + README.md | 586 ++++---------------------------- path.cabal => hpath.cabal | 16 +- src/HPath.hs | 415 ++++++++++++++++++++++ src/{Path => HPath}/Internal.hs | 19 +- src/Path.hs | 350 ------------------- test/Main.hs | 210 ++++++------ 9 files changed, 617 insertions(+), 984 deletions(-) rename path.cabal => hpath.cabal (68%) create mode 100644 src/HPath.hs rename src/{Path => HPath}/Internal.hs (68%) delete mode 100644 src/Path.hs diff --git a/.gitignore b/.gitignore index 45bdf12..37cf0d3 100644 --- a/.gitignore +++ b/.gitignore @@ -8,3 +8,5 @@ TAGS tags *.tag .stack-work/ +.cabal-sandbox/ +cabal.sandbox.config diff --git a/CHANGELOG b/CHANGELOG index d9db629..f79ac3b 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,5 @@ +0.5.8: + * First version of the fork. 0.5.7: * Fix haddock problem. 0.5.6: diff --git a/LICENSE b/LICENSE index 3c61bac..90ee70c 100644 --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,5 @@ Copyright (c) 2015–2016, FP Complete +Copyright (c) 2016, Julian Ospald All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md index 19775fa..b4997e4 100644 --- a/README.md +++ b/README.md @@ -1,518 +1,80 @@ -# Path +# HPath Support for well-typed paths in Haskell. -* [Motivation](#motivation) -* [Approach](#approach) -* [Solution](#solution) -* [Implementation](#implementation) - * [The data types](#the-data-types) - * [Parsers](#parsers) - * [Smart constructors](#smart-constructors) - * [Overloaded stings](#overloaded-strings) - * [Operations](#operations) -* [Review](#review) - * [Relative vs absolute confusion](#relative-vs-absolute-confusion) - * [The equality problem](#the-equality-problem) - * [Unpredictable concatenation issues](#unpredictable-concatenation-issues) - * [Confusing files and directories](#confusing-files-and-directories) - * [Self-documentation](#self-documentation) -* [In practice](#in-practice) -* [Doing I/O](#doing-io) -* [Doing textual manipulations](#doing-textual-manipulations) -* [Accepting user input](#accepting-user-input) -* [Comparing with existing path libraries](#comparing-with-existing-path-libraries) - * [filepath and system-filepath](#filepath-and-system-filepath) - * [system-canonicalpath, canonical-filepath, directory-tree](#system-canonicalpath-canonical-filepath-directory-tree) - * [pathtype](#pathtype) - * [data-filepath](#data-filepath) -* [Summary](#summary) - ## Motivation -It was after working on a number of projects at FP Complete that use file -paths in various ways. We used the system-filepath package, which was -supposed to solve many path problems by being an opaque path type. It -occurred to me that the same kind of bugs kept cropping up: +The motivation came during development of +[hsfm](https://github.com/hasufell/hsfm) +which has a pretty strict File type, but lacks a strict Path type, e.g. +for user input. + +The library that came closest to my needs was +[path](https://github.com/chrisdone/path), +but the API turned out to be oddly complicated for my use case, so I +decided to fork it. + +## Differences to 'path' + +I wasn't happy with the way it dealt with Dir vs File things. In his +version of the library, a `Path b Dir` always ends with a trailing +path separator and `Path b File` never ends with a trailing path separator. + +IMO, it is nonsensical to make a Dir vs File distinction on path level, +although it first seems nice. +Some of the reasons are: +* a path is just that: a path. It is completely disconnected from IO level + and even if a `Dir`/`File` type theoretically allows us to say "this path + ought to point to a file", there is literally zero guarantee that it will + hold true at runtime. So this basically gives a false feeling of a + type-safe file distinction. +* it's imprecise about Dir vs File distinction, which makes it even worse, + because a directory is also a file (just not a regular file). Add symlinks + to that and the confusion is complete. +* it makes the API oddly complicated for use cases where we basically don't + care (yet) whether something turns out to be a directory or not + +Still, it comes also with a few perks: +* it simplifies some functions, because they now have guarantees whether a + path ends in a trailing path separator or not +* it may be safer for interaction with other library functions, which behave + differently depending on a trailing path separator (like probably shelly) + +Not limited to, but also in order to fix my remarks without breaking any +benefits, I did: +* rename the `Dir`/`File` types to `TPS`/`NoTPS`, so it's clear we are only + giving information about trailing path separators and not actual file + types we don't know about yet +* add a `MaybeTPS` type, which does not mess with trailing path separators + and also gives no guarantees about them... then added `toNoTPS` and + `toTPS` to allow type-safe conversion +* make some functions accept more general types, so we don't unnecessarily + force paths with trailing separators for `()` for example... instead + these functions now examine the paths to still have correct behavior. + This is really minor overhead. You might say now "but then I can append + filepath to filepath". Well, as I said... we don't know whether it's a + "filepath" at all. +* merge `filename` and `dirname` into `basename` and make `parent` be + `dirname`, so the function names match the name of the POSIX ones, + which do (almost) the same... +* fix a bug in `basename` (formerly `dirname`) which broke the type + guarantees +* add a pattern synonym for easier pattern matching without exporting + the internal Path constructor + +## Consequences + +So what does that mean? Well, it means that this library does not and +cannot make any guarantees about what a filepath is meant for or what +it might point to. And it doesn't pretend it can. + +So when you strip the trailing path separator of a path that points to a +directory and then shove it into some function which expects a regular +file... then that function will very likely blow up. That's the nature of IO. +There is no type that can save you from interfacing such low-level libraries. +The filesystem is in constant change. What might have been a regular file +2 seconds ago, can now be a directory or a symlink. +That means you need a proper File type that is tied to your IO code. +This is what [hsfm](https://github.com/hasufell/hsfm) does. It currently +is not a library, maybe it will be in the future. -* Expected a path to be absolute but it was relative, or vice-versa. - -* Expected two equivalent paths to be equal or order the same, but they did - not (`/home//foo` vs `/home/foo/` vs `/home/bar/../foo`, etc.). - -* Unpredictable behaviour with regards to concatenating paths. - -* Confusing files and directories. - -* Not knowing whether a path was a file or directory or relative or absolute - based on the type alone was a drag. - -All of these bugs are preventable. - -## Approach - -My approach to problems like this is to make a type that encodes the -properties I want and then make it impossible to let those invariants be -broken, without compromise or backdoors to let the wrong value “slip -in”. Once I have a path, I want to be able to trust it fully. This theme -will be seen throughout the things I lay out below. - -## Solution - -After having to fix bugs due to these in our software, I put my foot down -and made: - -* An opaque `Path` type (a newtype wrapper around `String`). - -* Smart constructors which are very stringent in the parsing. - -* Make the parsers highly normalizing. - -* Leave equality and concatenation to basic string equality and - concatenation. - -* Include relativity (absolute/relative) and type (directory/file) in the - type itself. - -* Use the already cross-platform - [filepath](http://hackage.haskell.org/package/filepath) package for - implementation details. - -## Implementation - -### The data types - -Here is the type: - -```haskell -newtype Path b t = Path FilePath - deriving (Typeable) -``` - -The type variables are: - -* `b` — base, the base location of the path; absolute or relative. -* `t` — type, whether file or directory. - -The base types can be filled with these: - -```haskell -data Abs deriving (Typeable) -data Rel deriving (Typeable) -``` - -And the type can be filled with these: - -```haskell -data File deriving (Typeable) -data Dir deriving (Typeable) -``` - -(Why not use data kinds like `data Type = File | Dir`? Because that imposes -an extension overhead of adding `{-# LANGUAGE DataKinds #-}` to every module -you might want to write out a path type in. Given that one cannot construct -paths of types other than these, via the operations in the module, it’s not -a concern for me.) - -There is a conversion function to give you back the filepath: - -```haskell -toFilePath :: Path b t -> FilePath -toFilePath (Path l) = l -``` - -Beginning from version 0.5.3, there are type-constrained versions of -`toFilePath` with the following signatures: - -```haskell -fromAbsDir :: Path Abs Dir -> FilePath -fromRelDir :: Path Rel Dir -> FilePath -fromAbsFile :: Path Abs File -> FilePath -fromRelFile :: Path Rel File -> FilePath -``` - -### Parsers - -To get a `Path` value, you need to use one of the four parsers: - -```haskell -parseAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir) -parseRelDir :: MonadThrow m => FilePath -> m (Path Rel Dir) -parseAbsFile :: MonadThrow m => FilePath -> m (Path Abs File) -parseRelFile :: MonadThrow m => FilePath -> m (Path Rel File) -``` - -The following properties apply: - -* Absolute parsers will reject non-absolute paths. - -* The only delimiter syntax accepted is the path separator; `/` on POSIX and - `\` on Windows. - -* Any other delimiter is rejected; `..`, `~/`, `/./`, etc. - -* All parsers normalize into single separators: `/home//foo` → `/home/foo`. - -* Directory parsers always normalize with a final trailing `/`. So `/home/foo` - parses into the string `/home/foo/`. - -It was discussed briefly whether we should just have a class for parsing -rather than four separate parsing functions. In my experience so far, I have -had type errors where I wrote something `like x <- parseAbsDir -someAbsDirString` because `x` was then passed to a place that expected a -relative directory. In this way, overloading the return value would’ve just -been accepted. So I don’t think having a class is a good idea. Being -explicit here doesn’t exactly waste our time, either. - -Why are these functions in `MonadThrow`? Because it means I can have it -return an `Either`, or a `Maybe`, if I’m in pure code, and if I’m in `IO`, -and I don’t expect parsing to ever fail, I can use it in IO like this: - -```haskell -do x <- parseRelFile (fromCabalFileName x) - foo x - … -``` - -That’s really convenient and we take advantage of this at FP Complete a lot. -The instances - -Equality, ordering and printing are simply re-using the `String` instances: - -```haskell -instance Eq (Path b t) where - (==) (Path x) (Path y) = x == y - -instance Ord (Path b t) where - compare (Path x) (Path y) = compare x y - -instance Show (Path b t) where - show (Path x) = show x -``` - -Which gives us for free the following equational properties: - -```haskell -toFilePath x == toFilePath y ≡ x == y -- Eq instance -toFilePath x `compare` toFilePath y ≡ x `compare` y -- Ord instance -toFilePath x == toFilePath y ≡ show x == show y -- Show instance -``` - -In other words, the representation and the path you get out at the end are -the same. Two paths that are equal will always give you back the same thing. - -### Smart constructors - -For when you know what a path will be at compile-time, there are -constructors for that: - -```haskell -$(mkAbsDir "/home/chris") -$(mkRelDir "chris") -$(mkAbsFile "/home/chris/x.txt") -$(mkRelFile "chris/x.txt") -``` - -These will run at compile-time and underneath use the appropriate parser. - -### Overloaded strings - -No `IsString` instance is provided, because that has no way to statically -determine whether the path is correct, and would otherwise have to be a -partial function. - -In practice I have written the wrong path format in a `$(mk… "")` and been -thankful it was caught early. - -### Operations - -There is path concatenation: - -```haskell -() :: Path b Dir -> Path Rel t -> Path b t -``` - -Get the parent directory of a path: - -```haskell -parent :: Path Abs t -> Path Abs Dir -``` - -Get the filename of a file path: - -```haskell -filename :: Path b File -> Path Rel File -``` - -Get the directory name of a directory path: - -```haskell -dirname :: Path b Dir -> Path Rel Dir -``` - -Stripping the parent directory from a path: - -```haskell -stripDir :: MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) -``` - -## Review - -Let’s review my initial list of complaints and see if they’ve been -satisfied. - -### Relative vs absolute confusion - -Paths now distinguish in the type system whether they are relative or -absolute. You can’t append two absolute paths, for example: - -```haskell -λ> $(mkAbsDir "/home/chris") $(mkAbsDir "/home/chris") -:23:31-55: - Couldn't match type ‘Abs’ with ‘Rel’ -``` - -### The equality problem - -Paths are now stringently normalized. They have to be a valid path, and they -only support single path separators, and all directories are suffixed with a -trailing path separator: - -```haskell -λ> $(mkAbsDir "/home/chris//") == $(mkAbsDir "/./home//chris") -True -λ> toFilePath $(mkAbsDir "/home/chris//") == - toFilePath $(mkAbsDir "/./home//chris") -True -λ> ($(mkAbsDir "/home/chris//"),toFilePath $(mkAbsDir "/./home//chris")) -("/home/chris/","/home/chris/") -``` - -### Unpredictable concatenation issues - -Because of the stringent normalization, path concatenation, as seen above, -is simply string concatenation. This is about as predictable as it can get: - -```haskell -λ> toFilePath $(mkAbsDir "/home/chris//") -"/home/chris/" -λ> toFilePath $(mkRelDir "foo//bar") -"foo/bar/" -λ> $(mkAbsDir "/home/chris//") $(mkRelDir "foo//bar") -"/home/chris/foo/bar/" -``` - -### Confusing files and directories - -Now that the path type is encoded in the type system, our `` operator -prevents improper appending: - -```haskell -λ> $(mkAbsDir "/home/chris/") $(mkRelFile "foo//bar") -"/home/chris/foo/bar" -λ> $(mkAbsFile "/home/chris") $(mkRelFile "foo//bar") -:35:1-26: - Couldn't match type ‘File’ with ‘Dir’ -``` - -### Self-documentation - -Now I can read the path like: - -```haskell -{ fooPath :: Path Rel Dir, ... } -``` - -And know that this refers to the directory relative to some other path, -meaning I should be careful to consider the current directory when using -this in IO, or that I’ll probably need a parent to append to it at some -point. - -## In practice - -We’ve been using this at FP Complete in a number of packages for some months -now, it’s turned out surprisingly sufficient for most of our path work with -only one bug found. We weren’t sure initially whether it would just be too -much of a pain to use, but really it’s quite acceptable given the -advantages. You can see its use all over the -[`stack`](https://github.com/commercialhaskell/stack) codebase. - -## Doing I/O - -Currently any operations involving I/O can be done by using the existing I/O -library: - -```haskell -doesFileExist (toFilePath fp) -readFile (toFilePath fp) -``` - -etc. This has problems with respect to accidentally running something like: - -```haskell -doesFileExist $(mkRelDir "foo") -``` - -But I/O is currently outside the scope of what this package solves. Once you -leave the realm of the `Path` type invariants are back to your responsibility. - -As with the original version of this library, we’re currently building up a -set of functions in a `Path.IO` module over time that fits our real-world -use-cases. It may or may not appear in the path package eventually. It’ll -need cleaning up and considering what should really be included. - -**Edit:** There is now -[`path-io`](https://hackage.haskell.org/package/path-io) package that -complements the `path` library and includes complete well-typed interface to -[`directory`](https://hackage.haskell.org/package/directory) and -[`temporary`](https://hackage.haskell.org/package/temporary). There is work -to add more generally useful functions from Stack's `Path.IO` to it and make -Stack depend on the `path-io` package. - -## Doing textual manipulations - -One problem that crops up sometimes is wanting to manipulate -paths. Currently the way we do it is via the filepath library and re-parsing -the path: - -```haskell -parseAbsFile . addExtension "/directory/path" "ext" . toFilePath -``` - -It doesn’t happen too often, in our experience, to the extent this needs to -be more convenient. - -## Accepting user input - -Sometimes you have user input that contains `../`. The solution we went with -is to have a function like `resolveDir`: - -```haskell -resolveDir :: (MonadIO m, MonadThrow m) - => Path Abs Dir -> FilePath -> m (Path Abs Dir) -``` - -Which will call `canonicalizePath` which collapses and normalizes a path and -then we parse with regular old `parseAbsDir` and we’re cooking with -gas. This and others like it might get added to the `path` package. - -## Comparing with existing path libraries - -### filepath and system-filepath - -The [filepath](http://hackage.haskell.org/package/filepath) package is -intended as the complimentary package to be used before parsing into a Path -value, and/or after printing from a Path value. The package itself contains -no type-safety, instead contains a range of cross-platform textual -operations. Definitely reach for this library when you want to do more -involved manipulations. - -The `system-filepath` package is deprecated in favour of `filepath`. - -### system-canonicalpath, canonical-filepath, directory-tree - -The -[`system-canonicalpath`](http://hackage.haskell.org/package/system-canonicalpath) -and the -[`canonical-filepath`](http://hackage.haskell.org/package/canonical-filepath) -packages both are a kind of subset of `path`. They canonicalize a string -into an opaque path, but neither distinguish directories from files or -absolute/relative. Useful if you just want a canonical path but doesn’t do -anything else. - -The [`directory-tree`](http://hackage.haskell.org/package/directory-tree) -package contains a sum type of dir/file/etc but doesn’t distinguish in its -operations relativity or path type. - -### pathtype - -Finally, we come to a path library that path is similar to: the -[`pathtype`](http://hackage.haskell.org/package/pathtype) library. There are -the same types of `Path Abs File` / `Path Rel Dir`, etc. - -The points where this library isn’t enough for me are: - -* There is an `IsString` instance, which means people will use it, and will - make mistakes. - -* Paths are not normalized into a predictable format, leading to me being - unsure when equality will succeed. This is the same problem I encountered - in `system-filepath`. The equality function normalizes, but according to - what properties I can reason about? I don’t know. - -```haskell -System.Path.Posix> ("/tmp//" :: Path a Dir) == ("/tmp" :: Path a Dir) -True -System.Path.Posix> ("tmp" :: Path a Dir) == ("/tmp" :: Path a Dir) -True -System.Path.Posix> ("/etc/passwd/" :: Path a b) == ("/etc/passwd" :: Path a b) -True -System.Path.Posix> ("/tmp//" :: Path Abs Dir) == ("/tmp/./" :: Path Abs Dir) -False -System.Path.Posix> ("/tmp/../" :: Path Abs Dir) == ("/" :: Path Abs Dir) -False -``` -* Empty string should not be allowed, and introduction of `.` due to that - gets weird: - -```haskell -System.Path.Posix> fmap getPathString (Right ("." :: Path Rel File)) -Right "." -System.Path.Posix> fmap getPathString (mkPathAbsOrRel "") -Right "." -System.Path.Posix> (Right ("." :: Path Rel File)) == (mkPathAbsOrRel "") -False -System.Path.Posix> takeDirectory ("tmp" :: Path Rel Dir) -. -System.Path.Posix> (getPathString ("." :: Path Rel File) == - getPathString ("" :: Path Rel File)) -True -System.Path.Posix> (("." :: Path Rel File) == ("" :: Path Rel File)) -False -``` - -* It has functions like `<.>/addExtension` which lets you insert an - arbitrary string into a path. - -* Some functions let you produce nonsense (could be prevented by a stricter - type), for example: - -```haskell -System.Path.Posix> takeFileName ("/tmp/" :: Path Abs Dir) -tmp -``` - -I’m being a bit picky here, a bit unfair. But the point is really to show -the kind of things I tried to avoid in `path`. In summary, it’s just hard to -know where things can go wrong, similar to what was going on in -`system-filepath`. - -### data-filepath - -The [`data-filepath`](https://hackage.haskell.org/package/data-filepath) is -also very similar, I discovered it after writing my own at work and was -pleased to see it’s mostly the same. The main differences are: - -* Uses `DataKinds` for the relative/absolute and file/dir distinction which - as I said above is an overhead. - -* Uses a GADT for the path type, which is fine. In my case I wanted to - retain the original string which functions that work on the `FilePath` - (`String`) type already deal with well. It does change the parsing step - somewhat, because it parses into segments. - -* It’s more lenient at parsing (allowing `..` and trailing `.`). - -The API is a bit awkward to just parse a directory, requires a couple -functions to get it (going via `WeakFilePath`), returning only an `Either`, -and there are no functions like parent. But there’s not much to complain -about. It’s a fine library, but I didn’t feel the need to drop my own in -favor of it. Check it out and decide for yourself. - -## Summary - -There’s a growing interest in making practical use of well-typed file path -handling. I think everyone’s wanted it for a while, but few people have -really committed to it in practice. Now that I’ve been using `path` for a -while, I can’t really go back. It’ll be interesting to see what new packages -crop up in the coming year, I expect there’ll be more. diff --git a/path.cabal b/hpath.cabal similarity index 68% rename from path.cabal rename to hpath.cabal index 1e6f65d..931d811 100644 --- a/path.cabal +++ b/hpath.cabal @@ -1,12 +1,12 @@ -name: path -version: 0.5.7 +name: hpath +version: 0.5.8 synopsis: Support for well-typed paths description: Support for will-typed paths. license: BSD3 license-file: LICENSE -author: Chris Done -maintainer: Chris Done -copyright: 2015–2016 FP Complete +author: Julian Ospald +maintainer: Julian Ospald +copyright: 2015–2016 FP Complete, Julian Ospald 2016 category: Filesystem build-type: Simple cabal-version: >=1.8 @@ -15,7 +15,7 @@ extra-source-files: README.md, CHANGELOG library hs-source-dirs: src/ ghc-options: -Wall -O2 - exposed-modules: Path, Path.Internal + exposed-modules: HPath, HPath.Internal build-depends: base >= 4 && <5 , exceptions , filepath @@ -30,8 +30,8 @@ test-suite test , base , hspec , mtl - , path + , hpath source-repository head type: git - location: https://github.com/chrisdone/path.git + location: https://github.com/hasufell/hpath diff --git a/src/HPath.hs b/src/HPath.hs new file mode 100644 index 0000000..74ab325 --- /dev/null +++ b/src/HPath.hs @@ -0,0 +1,415 @@ +-- | +-- Module : HPath +-- Copyright : © 2015–2016 FP Complete, 2016 Julian Ospald +-- License : BSD 3 clause +-- +-- Maintainer : Julian Ospald +-- Stability : experimental +-- Portability : portable +-- +-- Support for well-typed paths. + +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE EmptyDataDecls #-} +{-# LANGUAGE PatternSynonyms #-} +{-# OPTIONS_HADDOCK ignore-exports #-} + +module HPath + ( + -- * Types + Abs + ,NoTPS + ,Path + ,Rel + ,TPS + -- * PatternSynonyms/ViewPatterns + ,pattern Path + -- * Parsing + ,PathParseException + ,parseAbsMaybeTPS + ,parseAbsNoTPS + ,parseAbsTPS + ,parseRelMaybeTPS + ,parseRelNoTPS + ,parseRelTPS + -- * Constructors + ,mkAbsMaybeTPS + ,mkAbsNoTPS + ,mkAbsTPS + ,mkRelMaybeTPS + ,mkRelNoTPS + ,mkRelTPS + -- * Operations + ,() + ,basename + ,dirname + ,isParentOf + ,stripDir + -- * Conversion + ,fromAbsMaybeTPS + ,fromAbsNoTPS + ,fromAbsTPS + ,fromRelMaybeTPS + ,fromRelNoTPS + ,fromRelTPS + ,toFilePath + ,toNoTPS + ,toTPS + ) + where + +import Control.Exception (Exception) +import Control.Monad.Catch (MonadThrow(..)) +import Data.Data +import Data.List +import Data.Maybe +import Language.Haskell.TH +import HPath.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 path without trailing separator. +data NoTPS deriving (Typeable) + +-- | A path with trailing separator. +data TPS deriving (Typeable) + +-- | A path without any guarantee about whether it ends in a +-- trailing path separators. Use `toTPS` and `toNoTPS` +-- if that guarantee is required. +data MaybeTPS deriving (Typeable) + +-- | Exception when parsing a location. +data PathParseException + = InvalidAbsTPS FilePath + | InvalidRelTPS FilePath + | InvalidAbsNoTPS FilePath + | InvalidRelNoTPS FilePath + | InvalidAbsMaybeTPS FilePath + | InvalidRelMaybeTPS FilePath + | Couldn'tStripPrefixTPS FilePath FilePath + deriving (Show,Typeable) +instance Exception PathParseException + +-------------------------------------------------------------------------------- +-- PatternSynonyms + +pattern Path x <- (MkPath x) + +-------------------------------------------------------------------------------- +-- Parsers + +-- | Get a location for an absolute path. Produces a normalized +-- path which always ends in a path separator. +-- +-- Throws: 'PathParseException' +-- +parseAbsTPS :: MonadThrow m + => FilePath -> m (Path Abs TPS) +parseAbsTPS filepath = + if FilePath.isAbsolute filepath && + not (null (normalizeTPS filepath)) && + not ("~/" `isPrefixOf` filepath) && + not (hasParentDir filepath) && + FilePath.isValid filepath + then return (MkPath (normalizeTPS filepath)) + else throwM (InvalidAbsTPS filepath) + +-- | Get a location for a relative path. Produces a normalized +-- path which always ends in a path separator. +-- +-- Note that @filepath@ may contain any number of @./@ but may not consist +-- solely of @./@. It also may not contain a single @..@ anywhere. +-- +-- Throws: 'PathParseException' +-- +parseRelTPS :: MonadThrow m + => FilePath -> m (Path Rel TPS) +parseRelTPS filepath = + if not (FilePath.isAbsolute filepath) && + not (null filepath) && + not ("~/" `isPrefixOf` filepath) && + not (hasParentDir filepath) && + not (null (normalizeTPS filepath)) && + filepath /= "." && filepath /= ".." && + FilePath.isValid filepath + then return (MkPath (normalizeTPS filepath)) + else throwM (InvalidRelTPS filepath) + +-- | Get a location for an absolute path, which must not end with a trailing +-- path separator. +-- +-- Throws: 'PathParseException' +-- +parseAbsNoTPS :: MonadThrow m + => FilePath -> m (Path Abs NoTPS) +parseAbsNoTPS filepath = + if FilePath.isAbsolute filepath && + not (FilePath.hasTrailingPathSeparator filepath) && + not ("~/" `isPrefixOf` filepath) && + not (hasParentDir filepath) && + not (null (normalizeNoTPS filepath)) && + FilePath.isValid filepath + then return (MkPath (normalizeNoTPS filepath)) + else throwM (InvalidAbsNoTPS filepath) + +-- | Get a location for a relative path, which must not end with a trailing +-- path separator. +-- +-- Note that @filepath@ may contain any number of @./@ but may not contain a +-- single @..@ anywhere. +-- +-- Throws: 'PathParseException' +-- +parseRelNoTPS :: MonadThrow m + => FilePath -> m (Path Rel NoTPS) +parseRelNoTPS filepath = + if not (FilePath.isAbsolute filepath || + FilePath.hasTrailingPathSeparator filepath) && + not (null filepath) && + not ("~/" `isPrefixOf` filepath) && + not (hasParentDir filepath) && + not (null (normalizeNoTPS filepath)) && + filepath /= "." && filepath /= ".." && + FilePath.isValid filepath + then return (MkPath (normalizeNoTPS filepath)) + else throwM (InvalidRelNoTPS filepath) + +-- | Get a location for an absolute path that may or may not end in a trailing +-- path separator. Use `toTPS` and `toNoTPS` if that guarantee is required. +-- +-- Throws: 'PathParseException' +-- +parseAbsMaybeTPS :: MonadThrow m + => FilePath -> m (Path Abs MaybeTPS) +parseAbsMaybeTPS filepath = + if FilePath.isAbsolute filepath && + not ("~/" `isPrefixOf` filepath) && + not (hasParentDir filepath) && + not (null (normalizeNoTPS filepath)) && + FilePath.isValid filepath + then return (MkPath (normalizeNoTPS filepath)) + else throwM (InvalidAbsMaybeTPS filepath) + +-- | Get a location for a relative path that may or may not end in a trailing +-- path separator. Use `toTPS` and `toNoTPS` if that guarantee is required. +-- +-- Note that @filepath@ may contain any number of @./@ but may not contain a +-- single @..@ anywhere. +-- +-- Throws: 'PathParseException' +-- +parseRelMaybeTPS :: MonadThrow m + => FilePath -> m (Path Rel MaybeTPS) +parseRelMaybeTPS filepath = + if not (FilePath.isAbsolute filepath) && + not (null filepath) && + not ("~/" `isPrefixOf` filepath) && + not (hasParentDir filepath) && + not (null (normalizeNoTPS filepath)) && + filepath /= "." && filepath /= ".." && + FilePath.isValid filepath + then return (MkPath (normalizeNoTPS filepath)) + else throwM (InvalidRelMaybeTPS 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 TPS'. +-- +-- 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). +mkAbsTPS :: FilePath -> Q Exp +mkAbsTPS s = + case parseAbsTPS s of + Left err -> error (show err) + Right (MkPath str) -> + [|MkPath $(return (LitE (StringL str))) :: Path Abs TPS|] + +-- | Make a 'Path Rel TPS'. +mkRelTPS :: FilePath -> Q Exp +mkRelTPS s = + case parseRelTPS s of + Left err -> error (show err) + Right (MkPath str) -> + [|MkPath $(return (LitE (StringL str))) :: Path Rel TPS|] + +-- | Make a 'Path Abs NoTPS'. +-- +-- 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). +mkAbsNoTPS :: FilePath -> Q Exp +mkAbsNoTPS s = + case parseAbsNoTPS s of + Left err -> error (show err) + Right (MkPath str) -> + [|MkPath $(return (LitE (StringL str))) :: Path Abs NoTPS|] + +-- | Make a 'Path Rel NoTPS'. +mkRelNoTPS :: FilePath -> Q Exp +mkRelNoTPS s = + case parseRelNoTPS s of + Left err -> error (show err) + Right (MkPath str) -> + [|MkPath $(return (LitE (StringL str))) :: Path Rel NoTPS|] + +-- | Make a 'Path Rel MaybeTPS'. +mkAbsMaybeTPS :: FilePath -> Q Exp +mkAbsMaybeTPS s = + case parseAbsMaybeTPS s of + Left err -> error (show err) + Right (MkPath str) -> + [|MkPath $(return (LitE (StringL str))) :: Path Abs MaybeTPS|] + +-- | Make a 'Path Rel MaybeTPS'. +mkRelMaybeTPS :: FilePath -> Q Exp +mkRelMaybeTPS s = + case parseRelMaybeTPS s of + Left err -> error (show err) + Right (MkPath str) -> + [|MkPath $(return (LitE (StringL str))) :: Path Rel MaybeTPS|] + +-------------------------------------------------------------------------------- +-- Conversion + +-- | Convert to a 'FilePath' type. +-- +-- All TPS data types 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 (MkPath l) = l + +fromAbsTPS :: Path Abs TPS -> FilePath +fromAbsTPS = toFilePath + +fromRelTPS :: Path Rel TPS -> FilePath +fromRelTPS = toFilePath + +fromAbsNoTPS :: Path Abs NoTPS -> FilePath +fromAbsNoTPS = toFilePath + +fromRelNoTPS :: Path Rel NoTPS -> FilePath +fromRelNoTPS = toFilePath + +fromAbsMaybeTPS :: Path Abs MaybeTPS -> FilePath +fromAbsMaybeTPS = toFilePath + +fromRelMaybeTPS :: Path Rel MaybeTPS -> FilePath +fromRelMaybeTPS = toFilePath + +toTPS :: Path b MaybeTPS -> Path b TPS +toTPS (MkPath l) = MkPath (FilePath.addTrailingPathSeparator l) + +toNoTPS :: Path b MaybeTPS -> Path b NoTPS +toNoTPS (MkPath l) = MkPath (FilePath.dropTrailingPathSeparator l) + +-------------------------------------------------------------------------------- +-- Operations + +-- | Append two paths. +-- +-- The second argument must always be a relative path, which ensures +-- that undefinable things like `"/abc" "/def"` cannot happen. +-- +-- Technically, the first argument can be a path that points to a non-directory, +-- because this library is IO-agnostic and makes no assumptions about +-- file types. +() :: Path b t1 -> Path Rel t2 -> Path b t2 +() (MkPath a) (MkPath b) = MkPath (a' ++ b) + where + a' = FilePath.addTrailingPathSeparator a + +-- | Strip directory from path, making it relative to that directory. +-- Throws 'Couldn'tStripPrefixDir' if directory is not a parent of the path. +-- +-- The bases must match. +-- +stripDir :: MonadThrow m + => Path b t1 -> Path b t2 -> m (Path Rel t2) +stripDir (MkPath p) (MkPath l) = + case stripPrefix p' l of + Nothing -> throwM (Couldn'tStripPrefixTPS p' l) + Just "" -> throwM (Couldn'tStripPrefixTPS p' l) + Just ok -> return (MkPath ok) + where + p' = FilePath.addTrailingPathSeparator p + +-- | Is p a parent of the given location? Implemented in terms of +-- 'stripDir'. The bases must match. +isParentOf :: Path b t1 -> Path b t2 -> Bool +isParentOf p l = + isJust (stripDir p l) + +-- | Extract the directory name of a path. +-- +-- The following properties hold: +-- +-- @dirname (p \<\/> a) == dirname p@ +-- +dirname :: Path Abs t -> Path Abs TPS +dirname (MkPath fp) = MkPath (normalizeTPS (FilePath.takeDirectory $ FilePath.dropTrailingPathSeparator fp)) + +-- | Extract the file part of a path. +-- +-- Throws InvalidRelTPS if it's passed e.g. '/', because there is no +-- basename for that and it would break the `Path Rel t` type. +-- +-- The following properties hold: +-- +-- @basename (p \<\/> a) == basename a@ +-- +basename :: MonadThrow m => Path b t -> m (Path Rel t) +basename (MkPath l) + | not (FilePath.isAbsolute rl) = return $ MkPath rl + | otherwise = throwM (InvalidRelTPS rl) + where + rl = case FilePath.hasTrailingPathSeparator l of + True -> last (FilePath.splitPath l) + False -> normalizeNoTPS (FilePath.takeFileName l) + +-------------------------------------------------------------------------------- +-- Internal functions + +-- | Internal use for normalizing a path while always adding +-- a trailing path separator. +normalizeTPS :: FilePath -> FilePath +normalizeTPS = + clean . FilePath.addTrailingPathSeparator . FilePath.normalise + where clean "./" = "" + clean ('/':'/':xs) = clean ('/':xs) + clean x = x + +-- | Internal use for normalizing a path without adding or removing +-- a trailing path separator. +normalizeNoTPS :: FilePath -> FilePath +normalizeNoTPS = + clean . FilePath.normalise + where clean "./" = "" + clean ('/':'/':xs) = clean ('/':xs) + clean x = x + diff --git a/src/Path/Internal.hs b/src/HPath/Internal.hs similarity index 68% rename from src/Path/Internal.hs rename to src/HPath/Internal.hs index b1f53cd..995a04e 100644 --- a/src/Path/Internal.hs +++ b/src/HPath/Internal.hs @@ -2,7 +2,7 @@ -- | Internal types and functions. -module Path.Internal +module HPath.Internal (Path(..)) where @@ -13,12 +13,12 @@ import Data.Data -- -- 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\/@ +-- 1. without trailing path separator: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@ +-- 2. with trailing path separator: @foo\/@, @\/foo\/bar\/@ -- --- All directories end in a trailing separator. There are no duplicate +-- There are no duplicate -- path separators @\/\/@, no @..@, no @.\/@, no @~\/@, etc. -newtype Path b t = Path FilePath +data Path b t = MkPath FilePath deriving (Typeable) -- | String equality. @@ -27,7 +27,7 @@ newtype Path b t = Path FilePath -- -- @show x == show y ≡ x == y@ instance Eq (Path b t) where - (==) (Path x) (Path y) = x == y + (==) (MkPath x) (MkPath y) = x == y -- | String ordering. -- @@ -35,7 +35,7 @@ instance Eq (Path b t) where -- -- @show x \`compare\` show y ≡ x \`compare\` y@ instance Ord (Path b t) where - compare (Path x) (Path y) = compare x y + compare (MkPath x) (MkPath y) = compare x y -- | Same as 'Path.toFilePath'. -- @@ -43,7 +43,8 @@ instance Ord (Path b t) where -- -- @x == y ≡ show x == show y@ instance Show (Path b t) where - show (Path x) = show x + show (MkPath x) = show x instance NFData (Path b t) where - rnf (Path x) = rnf x + rnf (MkPath x) = rnf x + diff --git a/src/Path.hs b/src/Path.hs deleted file mode 100644 index 152885a..0000000 --- a/src/Path.hs +++ /dev/null @@ -1,350 +0,0 @@ --- | --- Module : Path --- Copyright : © 2015–2016 FP Complete --- License : BSD 3 clause --- --- Maintainer : Chris Done --- Stability : experimental --- Portability : portable --- --- Support for well-typed paths. - -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE EmptyDataDecls #-} - -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) && - 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. --- --- Note that @filepath@ may contain any number of @./@ but may not consist solely of @./@. It also may not contain a single @..@ anywhere. --- --- 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 /= "." && filepath /= ".." && - FilePath.isValid 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.isValid filepath - then return (Path (normalizeFile filepath)) - else throwM (InvalidAbsFile filepath) - --- | Get a location for a relative file. --- --- Note that @filepath@ may contain any number of @./@ but may not contain a single @..@ anywhere. --- --- 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 /= "." && filepath /= ".." && - FilePath.isValid 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. --- 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. -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 diff --git a/test/Main.hs b/test/Main.hs index b9b80d6..851c080 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -8,8 +8,8 @@ import Control.Applicative import Control.Monad import Data.Maybe import Data.Monoid -import Path -import Path.Internal +import HPath +import HPath.Internal import Test.Hspec -- | Test suite entry point, returns exit failure if any test fails. @@ -19,15 +19,15 @@ 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 + do describe "Parsing: Path Abs Dir" parseAbsTPSSpec + describe "Parsing: Path Rel Dir" parseRelTPSSpec + describe "Parsing: Path Abs File" parseAbsNoTPSSpec + describe "Parsing: Path Rel File" parseRelNoTPSSpec describe "Operations: ()" operationAppend describe "Operations: stripDir" operationStripDir describe "Operations: isParentOf" operationIsParentOf - describe "Operations: parent" operationParent - describe "Operations: filename" operationFilename + describe "Operations: dirname" operationDirname + describe "Operations: basename" operationBasename describe "Restrictions" restrictions -- | Restricting the input of any tricks. @@ -44,107 +44,107 @@ restrictions = 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))) + (isNothing (void (parseAbsTPS x) <|> + void (parseRelTPS x) <|> + void (parseAbsNoTPS x) <|> + void (parseRelNoTPS 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 'basename' operation. +operationBasename :: Spec +operationBasename = + do it "basename ($(mkAbsTPS parent) basename $(mkRelNoTPS filename)) == $(mkRelNoTPS filename)" + ((basename =<< ($(mkAbsTPS "/home/hasufell/") ) + <$> basename $(mkRelNoTPS "bar.txt")) == + Just $(mkRelNoTPS "bar.txt")) + it "basename ($(mkRelTPS parent) basename $(mkRelNoTPS filename)) == $(mkRelNoTPS filename)" + ((basename =<< ($(mkRelTPS "home/hasufell/") ) + <$> basename $(mkRelNoTPS "bar.txt")) == + Just $(mkRelNoTPS "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 'dirname' operation. +operationDirname :: Spec +operationDirname = + do it "dirname (parent child) == parent" + (dirname ($(mkAbsTPS "/foo") + $(mkRelTPS "bar")) == + $(mkAbsTPS "/foo")) + it "dirname \"\" == \"\"" + (dirname $(mkAbsTPS "/") == + $(mkAbsTPS "/")) + it "dirname (parent \"\") == \"\"" + (dirname (dirname $(mkAbsTPS "/")) == + $(mkAbsTPS "/")) -- | The 'isParentOf' operation. operationIsParentOf :: Spec operationIsParentOf = do it "isParentOf parent (parent child)" (isParentOf - $(mkAbsDir "///bar/") - ($(mkAbsDir "///bar/") - $(mkRelFile "bar/foo.txt"))) + $(mkAbsTPS "///bar/") + ($(mkAbsTPS "///bar/") + $(mkRelNoTPS "bar/foo.txt"))) it "isParentOf parent (parent child)" (isParentOf - $(mkRelDir "bar/") - ($(mkRelDir "bar/") - $(mkRelFile "bob/foo.txt"))) + $(mkRelTPS "bar/") + ($(mkRelTPS "bar/") + $(mkRelNoTPS "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")) + (stripDir $(mkAbsTPS "///bar/") + ($(mkAbsTPS "///bar/") + $(mkRelNoTPS "bar/foo.txt")) == + Just $(mkRelNoTPS "bar/foo.txt")) it "stripDir parent (parent child) = child" - (stripDir $(mkRelDir "bar/") - ($(mkRelDir "bar/") - $(mkRelFile "bob/foo.txt")) == - Just $(mkRelFile "bob/foo.txt")) + (stripDir $(mkRelTPS "bar/") + ($(mkRelTPS "bar/") + $(mkRelNoTPS "bob/foo.txt")) == + Just $(mkRelNoTPS "bob/foo.txt")) it "stripDir parent parent = _|_" - (stripDir $(mkAbsDir "/home/chris/foo") - $(mkAbsDir "/home/chris/foo") == + (stripDir $(mkAbsTPS "/home/hasufell/foo") + $(mkAbsTPS "/home/hasufell/foo") == Nothing) -- | The '' operation. operationAppend :: Spec operationAppend = do it "AbsDir + RelDir = AbsDir" - ($(mkAbsDir "/home/") - $(mkRelDir "chris") == - $(mkAbsDir "/home/chris/")) + ($(mkAbsTPS "/home/") + $(mkRelTPS "hasufell") == + $(mkAbsTPS "/home/hasufell/")) it "AbsDir + RelFile = AbsFile" - ($(mkAbsDir "/home/") - $(mkRelFile "chris/test.txt") == - $(mkAbsFile "/home/chris/test.txt")) + ($(mkAbsTPS "/home/") + $(mkRelNoTPS "hasufell/test.txt") == + $(mkAbsNoTPS "/home/hasufell/test.txt")) it "RelDir + RelDir = RelDir" - ($(mkRelDir "home/") - $(mkRelDir "chris") == - $(mkRelDir "home/chris")) + ($(mkRelTPS "home/") + $(mkRelTPS "hasufell") == + $(mkRelTPS "home/hasufell")) it "RelDir + RelFile = RelFile" - ($(mkRelDir "home/") - $(mkRelFile "chris/test.txt") == - $(mkRelFile "home/chris/test.txt")) + ($(mkRelTPS "home/") + $(mkRelNoTPS "hasufell/test.txt") == + $(mkRelNoTPS "home/hasufell/test.txt")) -- | Tests for the tokenizer. -parseAbsDirSpec :: Spec -parseAbsDirSpec = +parseAbsTPSSpec :: Spec +parseAbsTPSSpec = 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) + succeeding "/" (MkPath "/") + succeeding "//" (MkPath "/") + succeeding "///foo//bar//mu/" (MkPath "/foo/bar/mu/") + succeeding "///foo//bar////mu" (MkPath "/foo/bar/mu/") + succeeding "///foo//bar/.//mu" (MkPath "/foo/bar/mu/") + where failing x = parserTest parseAbsTPS x Nothing + succeeding x with = parserTest parseAbsTPS x (Just with) -- | Tests for the tokenizer. -parseRelDirSpec :: Spec -parseRelDirSpec = +parseRelTPSSpec :: Spec +parseRelTPSSpec = do failing "" failing "/" failing "//" @@ -156,20 +156,20 @@ parseRelDirSpec = 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) + succeeding "..." (MkPath ".../") + succeeding "foo.bak" (MkPath "foo.bak/") + succeeding "./foo" (MkPath "foo/") + succeeding "././foo" (MkPath "foo/") + succeeding "./foo/./bar" (MkPath "foo/bar/") + succeeding "foo//bar//mu//" (MkPath "foo/bar/mu/") + succeeding "foo//bar////mu" (MkPath "foo/bar/mu/") + succeeding "foo//bar/.//mu" (MkPath "foo/bar/mu/") + where failing x = parserTest parseRelTPS x Nothing + succeeding x with = parserTest parseRelTPS x (Just with) -- | Tests for the tokenizer. -parseAbsFileSpec :: Spec -parseAbsFileSpec = +parseAbsNoTPSSpec :: Spec +parseAbsNoTPSSpec = do failing "" failing "./" failing "~/" @@ -177,16 +177,16 @@ parseAbsFileSpec = 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) + succeeding "/..." (MkPath "/...") + succeeding "/foo.txt" (MkPath "/foo.txt") + succeeding "///foo//bar////mu.txt" (MkPath "/foo/bar/mu.txt") + succeeding "///foo//bar/.//mu.txt" (MkPath "/foo/bar/mu.txt") + where failing x = parserTest parseAbsNoTPS x Nothing + succeeding x with = parserTest parseAbsNoTPS x (Just with) -- | Tests for the tokenizer. -parseRelFileSpec :: Spec -parseRelFileSpec = +parseRelNoTPSSpec :: Spec +parseRelNoTPSSpec = do failing "" failing "/" failing "//" @@ -197,16 +197,16 @@ parseRelFileSpec = failing "///foo//bar//mu/" failing "///foo//bar////mu" failing "///foo//bar/.//mu" - 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) + succeeding "..." (MkPath "...") + succeeding "foo.txt" (MkPath "foo.txt") + succeeding "./foo.txt" (MkPath "foo.txt") + succeeding "././foo.txt" (MkPath "foo.txt") + succeeding "./foo/./bar.txt" (MkPath "foo/bar.txt") + succeeding "foo//bar//mu.txt" (MkPath "foo/bar/mu.txt") + succeeding "foo//bar////mu.txt" (MkPath "foo/bar/mu.txt") + succeeding "foo//bar/.//mu.txt" (MkPath "foo/bar/mu.txt") + where failing x = parserTest parseRelNoTPS x Nothing + succeeding x with = parserTest parseRelNoTPS x (Just with) -- | Parser test. parserTest :: (Show a1,Show a,Eq a1)