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 constructortags/0.5.9
@@ -8,3 +8,5 @@ TAGS | |||
tags | |||
*.tag | |||
.stack-work/ | |||
.cabal-sandbox/ | |||
cabal.sandbox.config |
@@ -1,3 +1,5 @@ | |||
0.5.8: | |||
* First version of the fork. | |||
0.5.7: | |||
* Fix haddock problem. | |||
0.5.6: | |||
@@ -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 | |||
@@ -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: | |||
* 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") | |||
<interactive>: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") | |||
<interactive>: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 | |||
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. | |||
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. |
@@ -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 <chrisdone@fpcomplete.com> | |||
maintainer: Chris Done <chrisdone@fpcomplete.com> | |||
copyright: 2015–2016 FP Complete | |||
author: Julian Ospald <hasufell@posteo.de> | |||
maintainer: Julian Ospald <hasufell@posteo.de> | |||
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 |
@@ -0,0 +1,415 @@ | |||
-- | | |||
-- Module : HPath | |||
-- Copyright : © 2015–2016 FP Complete, 2016 Julian Ospald | |||
-- License : BSD 3 clause | |||
-- | |||
-- Maintainer : Julian Ospald <hasufell@posteo.de> | |||
-- 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 | |||
@@ -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. without trailing path separator: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@ | |||
-- 2. with trailing path separator: @foo\/@, @\/foo\/bar\/@ | |||
-- | |||
-- 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 | |||
@@ -1,350 +0,0 @@ | |||
-- | |||
-- | |||
{-# 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 | |||
-------------------------------------------------------------------------------- | |||
data Abs deriving (Typeable) | |||
data Rel deriving (Typeable) | |||
data File deriving (Typeable) | |||
data Dir deriving (Typeable) | |||
data PathParseException | |||
= InvalidAbsDir FilePath | |||
| InvalidRelDir FilePath | |||
| InvalidAbsFile FilePath | |||
| InvalidRelFile FilePath | |||
| Couldn'tStripPrefixDir FilePath FilePath | |||
deriving (Show,Typeable) | |||
instance Exception 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) | |||
-- | |||
-- | |||
-- | |||
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) | |||
-- | |||
-- | |||
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) | |||
-- | |||
-- | |||
-- | |||
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) | |||
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' | |||
-------------------------------------------------------------------------------- | |||
-- | |||
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|] | |||
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|] | |||
-- | |||
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|] | |||
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|] | |||
-------------------------------------------------------------------------------- | |||
-- | |||
toFilePath :: Path b t -> FilePath | |||
toFilePath (Path l) = l | |||
fromAbsDir :: Path Abs Dir -> FilePath | |||
fromAbsDir = toFilePath | |||
fromRelDir :: Path Rel Dir -> FilePath | |||
fromRelDir = toFilePath | |||
fromAbsFile :: Path Abs File -> FilePath | |||
fromAbsFile = toFilePath | |||
fromRelFile :: Path Rel File -> FilePath | |||
fromRelFile = toFilePath | |||
-------------------------------------------------------------------------------- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
(</>) :: Path b Dir -> Path Rel t -> Path b t | |||
(</>) (Path a) (Path b) = Path (a ++ b) | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
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) | |||
isParentOf :: Path b Dir -> Path b t -> Bool | |||
isParentOf p l = | |||
isJust (stripDir p l) | |||
-- | |||
-- | |||
-- | |||
-- | |||
-- | |||
parent :: Path Abs t -> Path Abs Dir | |||
parent (Path fp) = | |||
Path (normalizeDir (FilePath.takeDirectory (FilePath.dropTrailingPathSeparator fp))) | |||
-- | |||
-- | |||
-- | |||
filename :: Path b File -> Path Rel File | |||
filename (Path l) = | |||
Path (normalizeFile (FilePath.takeFileName l)) | |||
-- | |||
-- | |||
-- | |||
dirname :: Path b Dir -> Path Rel Dir | |||
dirname (Path l) = | |||
Path (last (FilePath.splitPath l)) | |||
-------------------------------------------------------------------------------- | |||
normalizeDir :: FilePath -> FilePath | |||
normalizeDir = | |||
clean . FilePath.addTrailingPathSeparator . FilePath.normalise | |||
where clean "./" = "" | |||
clean ('/':'/':xs) = clean ('/':xs) | |||
clean x = x | |||
normalizeFile :: FilePath -> FilePath | |||
normalizeFile = | |||
clean . FilePath.normalise | |||
where clean "./" = "" | |||
clean ('/':'/':xs) = clean ('/':xs) | |||
clean x = x |
@@ -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))) | |||
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")) | |||
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 "/")) | |||
(isNothing (void (parseAbsTPS x) <|> | |||
void (parseRelTPS x) <|> | |||
void (parseAbsNoTPS x) <|> | |||
void (parseRelNoTPS x))) | |||
-- | 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 '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) | |||