Compare commits

..

2 Commits

Author SHA1 Message Date
Julian Ospald 29923d1023 Add TODO 2016-03-06 22:07:54 +01:00
Julian Ospald c3c96ed371 Move Dir/File distinction to constructor level 2016-03-06 22:05:25 +01:00
80 changed files with 1227 additions and 8439 deletions

2
.ghci Executable file
View File

@ -0,0 +1,2 @@
:set -package HUnit -package hspec
:set -package template-haskell

4
.gitignore vendored
View File

@ -8,7 +8,3 @@ TAGS
tags
*.tag
.stack-work/
dist/
dist-newstyle/
.cabal-sandbox/
cabal.sandbox.config

View File

@ -1,84 +0,0 @@
# See https://github.com/hvr/multi-ghc-travis for more information
language: c
sudo: required
dist: trusty
matrix:
include:
- env: CABALVER=3.0 GHCVER=7.10.3 SKIP_DOCTESTS=yes
addons: {apt: {packages: [cabal-install-3.0,ghc-7.10.3], sources: [hvr-ghc]}}
before_install:
- sudo apt-get install -y hscolour
- export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- env: CABALVER=3.0 GHCVER=8.0.2 SKIP_DOCTESTS=yes
addons: {apt: {packages: [cabal-install-3.0,ghc-8.0.2], sources: [hvr-ghc]}}
before_install:
- sudo apt-get install -y hscolour
- export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- env: CABALVER=3.0 GHCVER=8.2.2
addons: {apt: {packages: [cabal-install-3.0,ghc-8.2.2], sources: [hvr-ghc]}}
before_install:
- sudo apt-get install -y hscolour
- export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- env: CABALVER=3.0 GHCVER=8.4.4
addons: {apt: {packages: [cabal-install-3.0,ghc-8.4.4], sources: [hvr-ghc]}}
before_install:
- sudo apt-get install -y hscolour
- export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- env: CABALVER=3.0 GHCVER=8.6.5
addons: {apt: {packages: [cabal-install-3.0,ghc-8.6.5], sources: [hvr-ghc]}}
before_install:
- sudo apt-get install -y hscolour
- export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- env: CABALVER=3.0 GHCVER=8.8.3
addons: {apt: {packages: [cabal-install-3.0,ghc-8.8.3], sources: [hvr-ghc]}}
before_install:
- sudo apt-get install -y hscolour
- export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- env: CABALVER=head GHCVER=head
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
before_install:
- sudo apt-get install -y hscolour
- export PATH=~/.cabal/bin:/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
- os: osx
osx_image: xcode11.3
language: generic
before_install:
- mkdir -p ~/.ghcup/bin
- curl https://gitlab.haskell.org/haskell/ghcup/raw/master/ghcup > ~/.ghcup/bin/ghcup
- chmod +x ~/.ghcup/bin/ghcup
- export PATH=~/.cabal/bin:~/.ghcup/bin:$PATH
- ghcup install 8.6.5
- ghcup set 8.6.5
- ghcup install-cabal 3.2.0.0
allow_failures:
- env: CABALVER=head GHCVER=head
env:
global:
- secure: HPBARvNM85ea2U0Ynq5MMe6BRlnuwqXWuSn20VY3EYCAT2njkVPYnR3O7+bGE6aq0KHAV87zz5iUfGJontd86tE0sDVjcSuRY0hqjOeJTkQq5M8WXJZOpVqlBTwDP1Q3x/fwoRa0dt9Z0tZZdKMlrf2XdcKPDdhcP1QYP4aV/jO4ZCfAQr7zVCvTae+Lp/KmwFYcBbFo/pj0duF1M4Oqx/D388b/W4jVE3lgd/TK7Ja1xWP6g+Oyvo6iQK8yJVYGdm6E+cVsNueiisnTJ/rRA53lsaC9dmWtZaFGl41wPviSU5zPq03vOuZMiyE2WtCHoo46ONXrXJ9N2soqdQVfEkr9Nw5LQl+6C5lCPEejZ575YUkuO05H3wvHMk3YY4zWXNFA9eZ47PEH8tpoUk9LPBacCKQFtp5lfRk63crba5CiFtcMyFq++0mLpNthNvtto7ffHMZrt6fvK9axI+r21VPftf/3FiFY4mnCp/Bln+ijklfZSN71VqiT20EWuqxQHw8aCpT00KA/PKGl9iJfoN4OO3XzNRTtmM+L9Im4bc1ni9YQ6N3UYg3z0nEnCLwFcTmTH/tDMHRremE0dM6B++YfcnyIhen8w+hG4bcXk7jbMUizRhUhStN7TZQuC9S4wE5whhp9c03rJZMmH5E2rlXY3lwVgeyWm1TuMp1RYWI=
install:
- cabal --version
- travis_retry cabal update
- cabal install --installdir=$HOME/.cabal/bin hspec-discover
- cabal install --installdir=$HOME/.cabal/bin doctest
script:
- cabal build --enable-tests all
- cabal test all
- ./hpath/run-doctests.sh
- ./hpath-filepath/run-doctests.sh
- (cd hpath && cabal check)
- (cd hpath-filepath && cabal check)
- (cd hpath-io && cabal check)
- cabal sdist all
- cabal install --lib all
notifications:
email:
- hasufell@posteo.de

31
CHANGELOG Normal file
View File

@ -0,0 +1,31 @@
0.5.7:
* Fix haddock problem.
0.5.6:
* Reject only .. and .
0.5.5:
* Use filepath's isValid function for additional sanity checks
0.5.4:
* Disable parsing of path consisting only of "."
* Add NFData instance for Path
* Some typo/docs improvements
* Add standard headers to modules
0.5.3:
* Added conversion functions.
0.2.0:
* Rename parentAbs to simply parent.
* Add dirname.
0.3.0:
* Removed Generic instance.
0.4.0:
* Implemented stricter parsing, disabling use of "..".
* Made stripDir generic over MonadThrow
0.5.0:
* Fix stripDir p p /= Nothing bug.
0.5.2:
* Removed unused DeriveGeneric.

24
LICENSE Normal file
View File

@ -0,0 +1,24 @@
Copyright (c) 20152016, FP Complete
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
* Neither the name of paths nor the
names of its contributors may be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

523
README.md
View File

@ -1,19 +1,518 @@
# HPath libraries
# Path
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath)
Support for well-typed paths in Haskell.
Set of libraries to deal with filepaths and files.
* [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
* filepaths should be type-safe (absolute, relative, ...)
* filepaths should be ByteString under the hood, see [Abstract FilePath Proposal (AFPP)](https://gitlab.haskell.org/ghc/ghc/wikis/proposal/abstract-file-path)
* file high-level operations should be platform-specific, exception-stable, safe and as atomic as possible
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:
## Projects
* Expected a path to be absolute but it was relative, or vice-versa.
* [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [hpath](./hpath): Support for well-typed paths
* [![Hackage version](https://img.shields.io/hackage/v/hpath-filepath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-filepath) [hpath-filepath](./hpath-filepath): ByteString based filepath manipulation (can be used without hpath)
* [![Hackage version](https://img.shields.io/hackage/v/hpath-directory.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-directory) [hpath-directory](./hpath-directory): High-level IO operations for files/directories on raw ByteString filepaths (use hpath-io for the type-safe path version)
* [![Hackage version](https://img.shields.io/hackage/v/hpath-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [hpath-io](./hpath-io): High-level IO operations for files/directories utilizing type-safe Path
* [![Hackage version](https://img.shields.io/hackage/v/hpath-posix.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-posix) [hpath-posix](./hpath-posix): Some low-level POSIX glue code that is not in 'unix'
* 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, its 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 wouldve just
been accepted. So I dont think having a class is a good idea. Being
explicit here doesnt 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 Im in pure code, and if Im in `IO`,
and I dont expect parsing to ever fail, I can use it in IO like this:
```haskell
do x <- parseRelFile (fromCabalFileName x)
foo x
```
Thats 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
Lets review my initial list of complaints and see if theyve been
satisfied.
### Relative vs absolute confusion
Paths now distinguish in the type system whether they are relative or
absolute. You cant 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 Ill probably need a parent to append to it at some
point.
## In practice
Weve been using this at FP Complete in a number of packages for some months
now, its turned out surprisingly sufficient for most of our path work with
only one bug found. We werent sure initially whether it would just be too
much of a pain to use, but really its 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, were 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. Itll
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 doesnt 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 were 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 doesnt do
anything else.
The [`directory-tree`](http://hackage.haskell.org/package/directory-tree)
package contains a sum type of dir/file/etc but doesnt 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 isnt 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 dont 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
```
Im 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, its 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 its 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.
* Its 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 theres not much to complain
about. Its a fine library, but I didnt feel the need to drop my own in
favor of it. Check it out and decide for yourself.
## Summary
Theres a growing interest in making practical use of well-typed file path
handling. I think everyones wanted it for a while, but few people have
really committed to it in practice. Now that Ive been using `path` for a
while, I cant really go back. Itll be interesting to see what new packages
crop up in the coming year, I expect therell be more.

View File

@ -1,12 +0,0 @@
packages: ./hpath
./hpath-directory
./hpath-filepath
./hpath-io
./hpath-posix
package hpath-io
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16
-- https://github.com/composewell/streamly/blob/master/docs/Build.md
package streamly
ghc-options: -O2 -fspec-constr-recursive=16 -fmax-worker-args=16

View File

@ -1,21 +0,0 @@
# Revision history for hpath-directory
## 0.13.4 -- 2020-05-08
* Add getDirsFilesStream and use streamly-posix for dircontents (#34)
## 0.13.3 -- 2020-04-14
* Fix tests on mac
## 0.13.2 -- 2020-02-17
* Fix bug in `createDirRecursive` with trailing path separators
## 0.13.1 -- 2020-01-29
* Split some functionality out into 'hpath-posix'
## 0.1.0.0 -- 2020-01-26
* First version. Released on an unsuspecting world.

View File

@ -1,30 +0,0 @@
Copyright (c) 2020, Julian Ospald
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Julian Ospald nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View File

@ -1,21 +0,0 @@
# HPath-filepath
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-directory.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-directory) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-directory.svg)](http://packdeps.haskellers.com/feed?needle=hpath-directory)
Support high-level IO operations on files/directories, utilizing ByteString
as FilePaths.
This package is part of the HPath suite, also check out:
* [hpath](https://hackage.haskell.org/package/hpath)
* [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath)
* [hpath-io](https://hackage.haskell.org/package/hpath-io)
## Motivation
This is basically a fork of [directory](https://hackage.haskell.org/package/directory), but is a complete rewrite and the API doesn't follow the directory package.
## Differences to 'posix-paths'
* has a custom versions of `openFd` which allows more control over the flags than its unix package counterpart
* adds a `getDirectoryContents'` version that works on Fd

View File

@ -1,116 +0,0 @@
cabal-version: >=1.10
name: hpath-directory
version: 0.13.4
synopsis: Alternative to 'directory' package with ByteString based filepaths
description: This provides a safer alternative to the 'directory'
package. FilePaths are ByteString based, so this
package only works on POSIX systems.
For a more high-level version of this with
proper Path type, use 'hpath-io', which makes
use of this package.
homepage: https://github.com/hasufell/hpath
bug-reports: https://github.com/hasufell/hpath/issues
license: BSD3
license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de>
maintainer: Julian Ospald <hasufell@posteo.de>
copyright: Julian Ospald <hasufell@posteo.de> 2020
category: Filesystem
build-type: Simple
extra-source-files: CHANGELOG.md
tested-with: GHC==7.10.3
, GHC==8.0.2
, GHC==8.2.2
, GHC==8.4.4
, GHC==8.6.5
, GHC==8.8.1
library
if os(windows)
build-depends: unbuildable<0
buildable: False
exposed-modules: System.Posix.RawFilePath.Directory
System.Posix.RawFilePath.Directory.Errors
-- other-modules:
-- other-extensions:
build-depends: base >= 4.8 && <5
, IfElse
, bytestring >= 0.10
, exceptions >= 0.10
, hpath-filepath >= 0.10.3
, hpath-posix >= 0.13
, safe-exceptions >= 0.1
, streamly >= 0.7
, streamly-bytestring >= 0.1.2
, streamly-posix >= 0.1.0.1
, time >= 1.8
, transformers
, unix >= 2.5
, unix-bytestring >= 0.3
, utf8-string
if impl(ghc < 8.0)
build-depends:
fail >= 4.9
hs-source-dirs: src
default-language: Haskell2010
default-extensions: PackageImports
test-suite spec
if os(windows)
build-depends: unbuildable<0
buildable: False
Type: exitcode-stdio-1.0
Default-Language: Haskell2010
Hs-Source-Dirs: test
Main-Is: Main.hs
other-modules:
System.Posix.RawFilePath.Directory.AppendFileSpec
System.Posix.RawFilePath.Directory.CanonicalizePathSpec
System.Posix.RawFilePath.Directory.CopyDirRecursiveCollectFailuresSpec
System.Posix.RawFilePath.Directory.CopyDirRecursiveOverwriteSpec
System.Posix.RawFilePath.Directory.CopyDirRecursiveSpec
System.Posix.RawFilePath.Directory.CopyFileOverwriteSpec
System.Posix.RawFilePath.Directory.CopyFileSpec
System.Posix.RawFilePath.Directory.CreateDirIfMissingSpec
System.Posix.RawFilePath.Directory.CreateDirRecursiveSpec
System.Posix.RawFilePath.Directory.CreateDirSpec
System.Posix.RawFilePath.Directory.CreateRegularFileSpec
System.Posix.RawFilePath.Directory.CreateSymlinkSpec
System.Posix.RawFilePath.Directory.DeleteDirRecursiveSpec
System.Posix.RawFilePath.Directory.DeleteDirSpec
System.Posix.RawFilePath.Directory.DeleteFileSpec
System.Posix.RawFilePath.Directory.GetDirsFilesSpec
System.Posix.RawFilePath.Directory.GetFileTypeSpec
System.Posix.RawFilePath.Directory.MoveFileOverwriteSpec
System.Posix.RawFilePath.Directory.MoveFileSpec
System.Posix.RawFilePath.Directory.ReadFileSpec
System.Posix.RawFilePath.Directory.RecreateSymlinkOverwriteSpec
System.Posix.RawFilePath.Directory.RecreateSymlinkSpec
System.Posix.RawFilePath.Directory.RenameFileSpec
System.Posix.RawFilePath.Directory.ToAbsSpec
System.Posix.RawFilePath.Directory.WriteFileLSpec
System.Posix.RawFilePath.Directory.WriteFileSpec
Spec
Utils
GHC-Options: -Wall
Build-Depends: base
, HUnit
, IfElse
, bytestring >= 0.10.0.0
, hpath-directory
, hpath-filepath >= 0.10
, hpath-posix >= 0.13
, hspec >= 1.3
, process
, time >= 1.8
, unix
, unix-bytestring
, utf8-string
default-extensions: PackageImports
source-repository head
type: git
location: https://github.com/hasufell/hpath

File diff suppressed because it is too large Load Diff

View File

@ -1,15 +0,0 @@
module System.Posix.RawFilePath.Directory where
import System.Posix.ByteString.FilePath (RawFilePath)
canonicalizePath :: RawFilePath -> IO RawFilePath
toAbs :: RawFilePath -> IO RawFilePath
doesFileExist :: RawFilePath -> IO Bool
doesDirectoryExist :: RawFilePath -> IO Bool
isWritable :: RawFilePath -> IO Bool
canOpenDirectory :: RawFilePath -> IO Bool

View File

@ -1,327 +0,0 @@
-- |
-- Module : System.Posix.RawFilePath.Directory.Errors
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Provides error handling.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.Posix.RawFilePath.Directory.Errors
(
-- * Types
HPathIOException(..)
, RecursiveFailureHint(..)
-- * Exception identifiers
, isSameFile
, isDestinationInSource
, isRecursiveFailure
, isReadContentsFailed
, isCreateDirFailed
, isCopyFileFailed
, isRecreateSymlinkFailed
-- * Path based functions
, throwFileDoesExist
, throwDirDoesExist
, throwSameFile
, sameFile
, throwDestinationInSource
-- * Error handling functions
, catchErrno
, rethrowErrnoAs
, handleIOError
, hideError
, bracketeer
, reactOnError
)
where
import Control.Applicative
(
(<$>)
)
import Control.Exception.Safe hiding (handleIOError)
import Control.Monad
(
forM
, when
)
import Control.Monad.IfElse
(
whenM
)
import Data.ByteString
(
ByteString
)
import qualified Data.ByteString as BS
import Data.ByteString.UTF8
(
toString
)
import Data.Typeable
(
Typeable
)
import Foreign.C.Error
(
getErrno
, Errno
)
import GHC.IO.Exception
(
IOErrorType
)
import {-# SOURCE #-} System.Posix.RawFilePath.Directory
(
canonicalizePath
, toAbs
, doesFileExist
, doesDirectoryExist
, isWritable
, canOpenDirectory
)
import System.IO.Error
(
alreadyExistsErrorType
, ioeGetErrorType
, mkIOError
)
import System.Posix.FilePath
import qualified System.Posix.Directory.ByteString as PFD
import System.Posix.Files.ByteString
(
fileAccess
, getFileStatus
)
import qualified System.Posix.Files.ByteString as PF
-- |Additional generic IO exceptions that the posix functions
-- do not provide.
data HPathIOException = SameFile ByteString ByteString
| DestinationInSource ByteString ByteString
| RecursiveFailure [(RecursiveFailureHint, IOException)]
deriving (Eq, Show, Typeable)
-- |A type for giving failure hints on recursive failure, which allows
-- to programmatically make choices without examining
-- the weakly typed I/O error attributes (like `ioeGetFileName`).
--
-- The first argument to the data constructor is always the
-- source and the second the destination.
data RecursiveFailureHint = ReadContentsFailed ByteString ByteString
| CreateDirFailed ByteString ByteString
| CopyFileFailed ByteString ByteString
| RecreateSymlinkFailed ByteString ByteString
deriving (Eq, Show)
instance Exception HPathIOException
toConstr :: HPathIOException -> String
toConstr SameFile {} = "SameFile"
toConstr DestinationInSource {} = "DestinationInSource"
toConstr RecursiveFailure {} = "RecursiveFailure"
-----------------------------
--[ Exception identifiers ]--
-----------------------------
isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty)
isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty)
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty)
isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool
isReadContentsFailed ReadContentsFailed{} = True
isReadContentsFailed _ = False
isCreateDirFailed CreateDirFailed{} = True
isCreateDirFailed _ = False
isCopyFileFailed CopyFileFailed{} = True
isCopyFileFailed _ = False
isRecreateSymlinkFailed RecreateSymlinkFailed{} = True
isRecreateSymlinkFailed _ = False
----------------------------
--[ Path based functions ]--
----------------------------
-- |Throws `AlreadyExists` `IOError` if file exists.
throwFileDoesExist :: RawFilePath -> IO ()
throwFileDoesExist bs =
whenM (doesFileExist bs)
(ioError . mkIOError
alreadyExistsErrorType
"File already exists"
Nothing
$ (Just (toString $ bs))
)
-- |Throws `AlreadyExists` `IOError` if directory exists.
throwDirDoesExist :: RawFilePath -> IO ()
throwDirDoesExist bs =
whenM (doesDirectoryExist bs)
(ioError . mkIOError
alreadyExistsErrorType
"Directory already exists"
Nothing
$ (Just (toString $ bs))
)
-- |Uses `isSameFile` and throws `SameFile` if it returns True.
throwSameFile :: RawFilePath
-> RawFilePath
-> IO ()
throwSameFile bs1 bs2 =
whenM (sameFile bs1 bs2)
(throwIO $ SameFile bs1 bs2)
-- |Check if the files are the same by examining device and file id.
-- This follows symbolic links.
sameFile :: RawFilePath -> RawFilePath -> IO Bool
sameFile fp1 fp2 =
handleIOError (\_ -> return False) $ do
fs1 <- getFileStatus fp1
fs2 <- getFileStatus fp2
if ((PF.deviceID fs1, PF.fileID fs1) ==
(PF.deviceID fs2, PF.fileID fs2))
then return True
else return False
-- TODO: make this more robust when destination does not exist
-- |Checks whether the destination directory is contained
-- within the source directory by comparing the device+file ID of the
-- source directory with all device+file IDs of the parent directories
-- of the destination.
throwDestinationInSource :: RawFilePath -- ^ source dir
-> RawFilePath -- ^ full destination, @dirname dest@
-- must exist
-> IO ()
throwDestinationInSource sbs dbs = do
destAbs <- toAbs dbs
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dbs)
<$> (canonicalizePath $ takeDirectory destAbs)
dids <- forM (takeAllParents dest') $ \p -> do
fs <- PF.getSymbolicLinkStatus p
return (PF.deviceID fs, PF.fileID fs)
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))
$ PF.getFileStatus sbs
when (elem sid dids)
(throwIO $ DestinationInSource dbs sbs)
where
basename x = let b = takeBaseName x
in if BS.null b then Nothing else Just b
--------------------------------
--[ Error handling functions ]--
--------------------------------
-- |Carries out an action, then checks if there is an IOException and
-- a specific errno. If so, then it carries out another action, otherwise
-- it rethrows the error.
catchErrno :: [Errno] -- ^ errno to catch
-> IO a -- ^ action to try, which can raise an IOException
-> IO a -- ^ action to carry out in case of an IOException and
-- if errno matches
-> IO a
catchErrno en a1 a2 =
catchIOError a1 $ \e -> do
errno <- getErrno
if errno `elem` en
then a2
else ioError e
-- |Execute the given action and retrow IO exceptions as a new Exception
-- that have the given errno. If errno does not match the exception is rethrown
-- as is.
rethrowErrnoAs :: Exception e
=> [Errno] -- ^ errno to catch
-> e -- ^ rethrow as if errno matches
-> IO a -- ^ action to try
-> IO a
rethrowErrnoAs en fmex action = catchErrno en action (throwIO fmex)
-- |Like `catchIOError`, with arguments swapped.
handleIOError :: (IOError -> IO a) -> IO a -> IO a
handleIOError = flip catchIOError
hideError :: IOErrorType -> IO () -> IO ()
hideError err = handleIO (\e -> if err == ioeGetErrorType e then pure () else ioError e)
-- |Like `bracket`, but allows to have different clean-up
-- actions depending on whether the in-between computation
-- has raised an exception or not.
bracketeer :: IO a -- ^ computation to run first
-> (a -> IO b) -- ^ computation to run last, when
-- no exception was raised
-> (a -> IO b) -- ^ computation to run last,
-- when an exception was raised
-> (a -> IO c) -- ^ computation to run in-between
-> IO c
bracketeer before after afterEx thing =
mask $ \restore -> do
a <- before
r <- restore (thing a) `onException` afterEx a
_ <- after a
return r
reactOnError :: IO a
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors
-> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException
-> IO a
reactOnError a ios fmios =
a `catches` [iohandler, fmiohandler]
where
iohandler = Handler $
\(ex :: IOException) ->
foldr (\(t, a') y -> if ioeGetErrorType ex == t
then a'
else y)
(throwIO ex)
ios
fmiohandler = Handler $
\(ex :: HPathIOException) ->
foldr (\(t, a') y -> if toConstr ex == toConstr t
then a'
else y)
(throwIO ex)
fmios

View File

@ -1,28 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString as BS
import Data.IORef
import Test.Hspec
import Test.Hspec.Runner
import Test.Hspec.Formatters
import qualified Spec
import Utils
import System.Posix.Temp.ByteString (mkdtemp)
import System.Posix.Env.ByteString (getEnvDefault)
import System.Posix.FilePath ((</>))
import "hpath-directory" System.Posix.RawFilePath.Directory
-- TODO: chardev, blockdev, namedpipe, socket
main :: IO ()
main = do
tmpdir <- getEnvDefault "TMPDIR" "/tmp" >>= canonicalizePath
tmpBase <- mkdtemp (tmpdir </> "hpath-directory")
writeIORef baseTmpDir (Just (tmpBase `BS.append` "/"))
putStrLn $ ("Temporary test directory at: " ++ show tmpBase)
hspecWith
defaultConfig { configFormatter = Just progress }
$ afterAll_ deleteBaseTmpDir
$ Spec.spec

View File

@ -1,2 +0,0 @@
-- file test/Spec.hs
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

View File

@ -1,108 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.AppendFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "AppendFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.appendFile" $ do
-- successes --
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllll"
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllllgagagaga"
it "appendFile file with content, everything clear" $ do
appendFile' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` "BLKASLblahfaselllllgagagaga"
it "appendFile file without content, everything clear" $ do
appendFile' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "appendFile, everything clear" $ do
appendFile' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllllgagagaga"
it "appendFile symlink, everything clear" $ do
appendFile' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll"
it "appendFile symlink, everything clear" $ do
appendFile' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga"
-- posix failures --
it "appendFile to dir, inappropriate type" $ do
appendFile' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "appendFile, no permissions to file" $ do
appendFile' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "appendFile, no permissions to file" $ do
appendFile' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "appendFile, file does not exist" $ do
appendFile' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@ -1,78 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CanonicalizePathSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CanonicalizePathSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "file"
createDir' "dir"
createSymlink' "dirSym" "dir/"
createSymlink' "brokenSym" "nothing"
createSymlink' "fileSym" "file"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "file"
deleteDir' "dir"
deleteFile' "dirSym"
deleteFile' "brokenSym"
deleteFile' "fileSym"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.canonicalizePath" $ do
-- successes --
it "canonicalizePath, all fine" $ do
path <- withTmpDir "file" return
canonicalizePath' "file"
`shouldReturn` path
it "canonicalizePath, all fine" $ do
path <- withTmpDir "dir" return
canonicalizePath' "dir"
`shouldReturn` path
it "canonicalizePath, all fine" $ do
path <- withTmpDir "file" return
canonicalizePath' "fileSym"
`shouldReturn` path
it "canonicalizePath, all fine" $ do
path <- withTmpDir "dir" return
canonicalizePath' "dirSym"
`shouldReturn` path
-- posix failures --
it "canonicalizePath, broken symlink" $
canonicalizePath' "brokenSym"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "canonicalizePath, file does not exist" $
canonicalizePath' "nothingBlah"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)

View File

@ -1,248 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CopyDirRecursiveCollectFailuresSpec where
import Test.Hspec
import Data.List (sort)
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyDirRecursiveCollectFailuresSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "alreadyExists"
createRegularFile' "wrongInput"
createSymlink' "wrongInputSymL" "inputDir/"
createDir' "alreadyExistsD"
createDir' "noPerms"
createDir' "noWritePerm"
createDir' "inputDir"
createDir' "inputDir/bar"
createDir' "inputDir/foo"
createRegularFile' "inputDir/foo/inputFile1"
createRegularFile' "inputDir/inputFile2"
createRegularFile' "inputDir/bar/inputFile3"
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"
writeFile' "inputDir/inputFile2" "Blahfaselgagaga"
writeFile' "inputDir/bar/inputFile3"
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"
createDir' "inputDir1"
createDir' "inputDir1/foo2"
createDir' "inputDir1/foo2/foo3"
createDir' "inputDir1/foo2/foo4"
createRegularFile' "inputDir1/foo2/inputFile1"
createRegularFile' "inputDir1/foo2/inputFile2"
createRegularFile' "inputDir1/foo2/inputFile3"
createRegularFile' "inputDir1/foo2/foo4/inputFile4"
createRegularFile' "inputDir1/foo2/foo4/inputFile6"
createRegularFile' "inputDir1/foo2/foo3/inputFile5"
noPerms "inputDir1/foo2/foo3"
createDir' "outputDir1"
createDir' "outputDir1/foo2"
createDir' "outputDir1/foo2/foo4"
createDir' "outputDir1/foo2/foo4/inputFile4"
createRegularFile' "outputDir1/foo2/foo4/inputFile6"
noPerms "outputDir1/foo2/foo4/inputFile4"
noPerms "outputDir1/foo2/foo4"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
normalDirPerms "inputDir1/foo2/foo3"
deleteFile' "inputDir1/foo2/foo4/inputFile4"
deleteFile' "inputDir1/foo2/foo4/inputFile6"
deleteFile' "inputDir1/foo2/inputFile1"
deleteFile' "inputDir1/foo2/inputFile2"
deleteFile' "inputDir1/foo2/inputFile3"
deleteFile' "inputDir1/foo2/foo3/inputFile5"
deleteDir' "inputDir1/foo2/foo3"
deleteDir' "inputDir1/foo2/foo4"
deleteDir' "inputDir1/foo2"
deleteDir' "inputDir1"
normalDirPerms "outputDir1/foo2/foo4"
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
deleteFile' "outputDir1/foo2/foo4/inputFile6"
deleteDir' "outputDir1/foo2/foo4/inputFile4"
deleteDir' "outputDir1/foo2/foo4"
deleteDir' "outputDir1/foo2"
deleteDir' "outputDir1"
deleteFile' "alreadyExists"
deleteFile' "wrongInput"
deleteFile' "wrongInputSymL"
deleteDir' "alreadyExistsD"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
deleteFile' "inputDir/foo/inputFile1"
deleteFile' "inputDir/inputFile2"
deleteFile' "inputDir/bar/inputFile3"
deleteDir' "inputDir/foo"
deleteDir' "inputDir/bar"
deleteDir' "inputDir"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do
-- successes --
it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir"
"outputDir"
Strict
CollectFailures
(system $ "diff -r "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir"
++ " >/dev/null")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
-- posix failures --
it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $
copyDirRecursive' "doesNotExist"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $
copyDirRecursive' "noPerms/inputDir"
"foo"
Strict
CollectFailures
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures
it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do
copyDirRecursive' "inputDir1/foo2"
"outputDir1/foo2"
Overwrite
CollectFailures
`shouldThrow`
(\(RecursiveFailure ex@[_, _]) ->
any (\(h, e) -> ioeGetErrorType e == InappropriateType
&& isCopyFileFailed h) ex &&
any (\(h, e) -> ioeGetErrorType e == PermissionDenied
&& isReadContentsFailed h) ex)
normalDirPerms "outputDir1/foo2/foo4"
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
c <- allDirectoryContents' "outputDir1"
tmpDir' <- getRawTmpDir
let shouldC = (fmap (\x -> tmpDir' `BS.append` x)
["outputDir1"
,"outputDir1/foo2"
,"outputDir1/foo2/inputFile1"
,"outputDir1/foo2/inputFile2"
,"outputDir1/foo2/inputFile3"
,"outputDir1/foo2/foo4"
,"outputDir1/foo2/foo4/inputFile6"
,"outputDir1/foo2/foo4/inputFile4"])
deleteFile' "outputDir1/foo2/inputFile1"
deleteFile' "outputDir1/foo2/inputFile2"
deleteFile' "outputDir1/foo2/inputFile3"
sort c `shouldBe` sort shouldC
it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $
copyDirRecursive' "inputDir"
"noWritePerm/foo"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $
copyDirRecursive' "inputDir"
"noPerms/foo"
Strict
CollectFailures
`shouldThrow`
isRecursiveFailure
it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $
copyDirRecursive' "inputDir"
"alreadyExistsD"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $
copyDirRecursive' "inputDir"
"alreadyExists"
Strict
CollectFailures
`shouldThrow`
isRecursiveFailure
it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $
copyDirRecursive' "wrongInput"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument)
it "copyDirRecursive (Strict, CollectFailures), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Strict
CollectFailures
`shouldThrow`
isDestinationInSource
it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Strict
CollectFailures
`shouldThrow`
isSameFile

View File

@ -1,205 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CopyDirRecursiveOverwriteSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyDirRecursiveOverwriteSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "alreadyExists"
createRegularFile' "wrongInput"
createSymlink' "wrongInputSymL" "inputDir/"
createDir' "noPerms"
createDir' "noWritePerm"
createDir' "inputDir"
createDir' "inputDir/bar"
createDir' "inputDir/foo"
createRegularFile' "inputDir/foo/inputFile1"
createRegularFile' "inputDir/inputFile2"
createRegularFile' "inputDir/bar/inputFile3"
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"
writeFile' "inputDir/inputFile2" "Blahfaselgagaga"
writeFile' "inputDir/bar/inputFile3"
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"
createDir' "alreadyExistsD"
createDir' "alreadyExistsD/bar"
createDir' "alreadyExistsD/foo"
createRegularFile' "alreadyExistsD/foo/inputFile1"
createRegularFile' "alreadyExistsD/inputFile2"
createRegularFile' "alreadyExistsD/bar/inputFile3"
writeFile' "alreadyExistsD/foo/inputFile1" "DAAsada"
writeFile' "alreadyExistsD/inputFile2" "ahfaagaga"
writeFile' "alreadyExistsD/bar/inputFile3"
"f3223sasdasdaasdasdasasd4"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "alreadyExists"
deleteFile' "wrongInput"
deleteFile' "wrongInputSymL"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
deleteFile' "inputDir/foo/inputFile1"
deleteFile' "inputDir/inputFile2"
deleteFile' "inputDir/bar/inputFile3"
deleteDir' "inputDir/foo"
deleteDir' "inputDir/bar"
deleteDir' "inputDir"
deleteFile' "alreadyExistsD/foo/inputFile1"
deleteFile' "alreadyExistsD/inputFile2"
deleteFile' "alreadyExistsD/bar/inputFile3"
deleteDir' "alreadyExistsD/foo"
deleteDir' "alreadyExistsD/bar"
deleteDir' "alreadyExistsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do
-- successes --
it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do
copyDirRecursive' "inputDir"
"outputDir"
Overwrite
FailEarly
removeDirIfExists "outputDir"
it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir"
"outputDir"
Overwrite
FailEarly
(system $ "diff -r "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir"
++ " >/dev/null")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do
tmpDir' <- getRawTmpDir
(system $ "diff -r "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "alreadyExistsD"
++ " >/dev/null")
`shouldReturn` (ExitFailure 1)
copyDirRecursive' "inputDir"
"alreadyExistsD"
Overwrite
FailEarly
(system $ "diff -r "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "alreadyExistsD"
++ " >/dev/null")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
-- posix failures --
it "copyDirRecursive, source directory does not exist" $
copyDirRecursive' "doesNotExist"
"outputDir"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive, no write permission on output dir" $
copyDirRecursive' "inputDir"
"noWritePerm/foo"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open output dir" $
copyDirRecursive' "inputDir"
"noPerms/foo"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open source dir" $
copyDirRecursive' "noPerms/inputDir"
"foo"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, destination already exists and is a file" $
copyDirRecursive' "inputDir"
"alreadyExists"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive, wrong input (regular file)" $
copyDirRecursive' "wrongInput"
"outputDir"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive, wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures
it "copyDirRecursive (Overwrite, FailEarly), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Overwrite
FailEarly
`shouldThrow`
isDestinationInSource
it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Overwrite
FailEarly
`shouldThrow`
isSameFile

View File

@ -1,181 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CopyDirRecursiveSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyDirRecursiveSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "alreadyExists"
createRegularFile' "wrongInput"
createSymlink' "wrongInputSymL" "inputDir/"
createDir' "alreadyExistsD"
createDir' "noPerms"
createDir' "noWritePerm"
createDir' "inputDir"
createDir' "inputDir/bar"
createDir' "inputDir/foo"
createRegularFile' "inputDir/foo/inputFile1"
createRegularFile' "inputDir/inputFile2"
createRegularFile' "inputDir/bar/inputFile3"
writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"
writeFile' "inputDir/inputFile2" "Blahfaselgagaga"
writeFile' "inputDir/bar/inputFile3"
"fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "alreadyExists"
deleteFile' "wrongInput"
deleteFile' "wrongInputSymL"
deleteDir' "alreadyExistsD"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
deleteFile' "inputDir/foo/inputFile1"
deleteFile' "inputDir/inputFile2"
deleteFile' "inputDir/bar/inputFile3"
deleteDir' "inputDir/foo"
deleteDir' "inputDir/bar"
deleteDir' "inputDir"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.copyDirRecursive" $ do
-- successes --
it "copyDirRecursive (Strict, FailEarly), all fine" $ do
copyDirRecursive' "inputDir"
"outputDir"
Strict
FailEarly
removeDirIfExists "outputDir"
it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir"
"outputDir"
Strict
FailEarly
(system $ "diff -r "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir"
++ " >/dev/null")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
-- posix failures --
it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $
copyDirRecursive' "doesNotExist"
"outputDir"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $
copyDirRecursive' "inputDir"
"noWritePerm/foo"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $
copyDirRecursive' "inputDir"
"noPerms/foo"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $
copyDirRecursive' "noPerms/inputDir"
"foo"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $
copyDirRecursive' "inputDir"
"alreadyExistsD"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $
copyDirRecursive' "inputDir"
"alreadyExists"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $
copyDirRecursive' "wrongInput"
"outputDir"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures
it "copyDirRecursive (Strict, FailEarly), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Strict
FailEarly
`shouldThrow`
isDestinationInSource
it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Strict
FailEarly
`shouldThrow`
isSameFile

View File

@ -1,148 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CopyFileOverwriteSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileOverwriteSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "inputFile"
createRegularFile' "alreadyExists"
createSymlink' "inputFileSymL" "inputFile"
createDir' "alreadyExistsD"
createDir' "noPerms"
createRegularFile' "noPerms/inputFile"
createDir' "outputDirNoWrite"
createDir' "wrongInput"
noPerms "noPerms"
noWritableDirPerms "outputDirNoWrite"
writeFile' "inputFile" "Blahfaselgagaga"
writeFile' "alreadyExists" "dsaldsalkaklsdlkasksdadasl"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "outputDirNoWrite"
deleteFile' "noPerms/inputFile"
deleteFile' "inputFile"
deleteFile' "alreadyExists"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
deleteDir' "noPerms"
deleteDir' "outputDirNoWrite"
deleteDir' "wrongInput"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.copyFile" $ do
-- successes --
it "copyFile (Overwrite), everything clear" $ do
copyFile' "inputFile"
"outputFile"
Overwrite
removeFileIfExists "outputFile"
it "copyFile (Overwrite), output file already exists, all clear" $ do
tmpDir' <- getRawTmpDir
copyFile' "alreadyExists" "alreadyExists.bak" Strict
copyFile' "inputFile" "alreadyExists" Overwrite
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir' ++ "alreadyExists")
`shouldReturn` ExitSuccess
removeFileIfExists "alreadyExists"
copyFile' "alreadyExists.bak" "alreadyExists" Strict
removeFileIfExists "alreadyExists.bak"
it "copyFile (Overwrite), and compare" $ do
tmpDir' <- getRawTmpDir
copyFile' "inputFile"
"outputFile"
Overwrite
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir' ++ "outputFile")
`shouldReturn` ExitSuccess
removeFileIfExists "outputFile"
-- posix failures --
it "copyFile (Overwrite), input file does not exist" $
copyFile' "noSuchFile"
"outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile (Overwrite), no permission to write to output directory" $
copyFile' "inputFile"
"outputDirNoWrite/outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), cannot open output directory" $
copyFile' "inputFile"
"noPerms/outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), cannot open source directory" $
copyFile' "noPerms/inputFile"
"outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), wrong input type (symlink)" $
copyFile' "inputFileSymL"
"outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile (Overwrite), wrong input type (directory)" $
copyFile' "wrongInput"
"outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyFile (Overwrite), output file already exists and is a dir" $
copyFile' "inputFile"
"alreadyExistsD"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
-- custom failures --
it "copyFile (Overwrite), output and input are same file" $
copyFile' "inputFile"
"inputFile"
Overwrite
`shouldThrow` isSameFile

View File

@ -1,143 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CopyFileSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import Utils
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "inputFile"
createRegularFile' "alreadyExists"
createSymlink' "inputFileSymL" "inputFile"
createDir' "alreadyExistsD"
createDir' "noPerms"
createRegularFile' "noPerms/inputFile"
createDir' "outputDirNoWrite"
createDir' "wrongInput"
noPerms "noPerms"
noWritableDirPerms "outputDirNoWrite"
writeFile' "inputFile" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "outputDirNoWrite"
deleteFile' "noPerms/inputFile"
deleteFile' "inputFile"
deleteFile' "alreadyExists"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
deleteDir' "noPerms"
deleteDir' "outputDirNoWrite"
deleteDir' "wrongInput"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.copyFile" $ do
-- successes --
it "copyFile (Strict), everything clear" $ do
copyFile' "inputFile"
"outputFile"
Strict
removeFileIfExists "outputFile"
it "copyFile (Strict), and compare" $ do
tmpDir' <- getRawTmpDir
copyFile' "inputFile"
"outputFile"
Strict
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir' ++ "outputFile")
`shouldReturn` ExitSuccess
removeFileIfExists "outputFile"
-- posix failures --
it "copyFile (Strict), input file does not exist" $
copyFile' "noSuchFile"
"outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile (Strict), no permission to write to output directory" $
copyFile' "inputFile"
"outputDirNoWrite/outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Strict), cannot open output directory" $
copyFile' "inputFile"
"noPerms/outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Strict), cannot open source directory" $
copyFile' "noPerms/inputFile"
"outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Strict), wrong input type (symlink)" $
copyFile' "inputFileSymL"
"outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile (Strict), wrong input type (directory)" $
copyFile' "wrongInput"
"outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyFile (Strict), output file already exists" $
copyFile' "inputFile"
"alreadyExists"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyFile (Strict), output file already exists and is a dir" $
copyFile' "inputFile"
"alreadyExistsD"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures --
it "copyFile (Strict), output and input are same file" $
copyFile' "inputFile"
"inputFile"
Strict
`shouldThrow`
isSameFile

View File

@ -1,69 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CreateDirIfMissingSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateDirIfMissingSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createDir' "alreadyExists"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteDir' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.CreateDirIfMissing" $ do
-- successes --
it "createDirIfMissing, all fine" $ do
createDirIfMissing' "newDir"
removeDirIfExists "newDir"
it "createDirIfMissing, destination directory already exists" $
createDirIfMissing' "alreadyExists"
-- posix failures --
it "createDirIfMissing, parent directories do not exist" $
createDirIfMissing' "some/thing/dada"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createDirIfMissing, can't write to output directory" $
createDirIfMissing' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDirIfMissing, can't open output directory" $
createDirIfMissing' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@ -1,83 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CreateDirRecursiveSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateDirRecursiveSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createDir' "alreadyExists"
createRegularFile' "alreadyExistsF"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteDir' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
deleteFile' "alreadyExistsF"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.createDirRecursive" $ do
-- successes --
it "createDirRecursive, all fine" $ do
createDirRecursive' "newDir"
deleteDir' "newDir"
it "createDirRecursive with trailing path separator, all fine" $ do
createDirRecursive' "newDir/foo/"
deleteDir' "newDir/foo"
deleteDir' "newDir"
it "createDirRecursive, parent directories do not exist" $ do
createDirRecursive' "some/thing/dada"
deleteDir' "some/thing/dada"
deleteDir' "some/thing"
deleteDir' "some"
it "createDirRecursive, destination directory already exists" $
createDirRecursive' "alreadyExists"
-- posix failures --
it "createDirRecursive, destination already exists and is a file" $
createDirRecursive' "alreadyExistsF"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "createDirRecursive, can't write to output directory" $
createDirRecursive' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDirRecursive, can't open output directory" $
createDirRecursive' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@ -1,72 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CreateDirSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateDirSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createDir' "alreadyExists"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteDir' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.createDir" $ do
-- successes --
it "createDir, all fine" $ do
createDir' "newDir"
removeDirIfExists "newDir"
-- posix failures --
it "createDir, parent directories do not exist" $
createDir' "some/thing/dada"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createDir, can't write to output directory" $
createDir' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDir, can't open output directory" $
createDir' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDir, destination directory already exists" $
createDir' "alreadyExists"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)

View File

@ -1,70 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CreateRegularFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateRegularFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "alreadyExists"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteFile' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.createRegularFile" $ do
-- successes --
it "createRegularFile, all fine" $ do
createRegularFile' "newDir"
removeFileIfExists "newDir"
-- posix failures --
it "createRegularFile, parent directories do not exist" $
createRegularFile' "some/thing/dada"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createRegularFile, can't write to destination directory" $
createRegularFile' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, can't write to destination directory" $
createRegularFile' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, destination file already exists" $
createRegularFile' "alreadyExists"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)

View File

@ -1,71 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.CreateSymlinkSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateSymlinkSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "alreadyExists"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteFile' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.createSymlink" $ do
-- successes --
it "createSymlink, all fine" $ do
createSymlink' "newSymL" "alreadyExists/"
removeFileIfExists "newSymL"
-- posix failures --
it "createSymlink, parent directories do not exist" $
createSymlink' "some/thing/dada" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createSymlink, can't write to destination directory" $
createSymlink' "noWritePerms/newDir" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createSymlink, can't write to destination directory" $
createSymlink' "noPerms/newDir" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createSymlink, destination file already exists" $
createSymlink' "alreadyExists" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)

View File

@ -1,116 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.DeleteDirRecursiveSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Files.ByteString
(
getSymbolicLinkStatus
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteDirRecursiveSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "file"
createDir' "dir"
createRegularFile' "dir/.keep"
createSymlink' "dirSym" "dir/"
createDir' "noPerms"
createRegularFile' "noPerms/.keep"
createDir' "noWritable"
createRegularFile' "noWritable/.keep"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "file"
deleteFile' "dir/.keep"
deleteDir' "dir"
deleteFile' "dirSym"
deleteFile' "noPerms/.keep"
deleteDir' "noPerms"
deleteFile' "noWritable/.keep"
deleteDir' "noWritable"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.deleteDirRecursive" $ do
-- successes --
it "deleteDirRecursive, empty directory, all fine" $ do
createDir' "testDir"
deleteDirRecursive' "testDir"
getSymbolicLinkStatus "testDir"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
createDir' "noPerms/testDir"
noPerms "noPerms/testDir"
deleteDirRecursive' "noPerms/testDir"
it "deleteDirRecursive, non-empty directory, all fine" $ do
createDir' "nonEmpty"
createDir' "nonEmpty/dir1"
createDir' "nonEmpty/dir2"
createDir' "nonEmpty/dir2/dir3"
createRegularFile' "nonEmpty/file1"
createRegularFile' "nonEmpty/dir1/file2"
deleteDirRecursive' "nonEmpty"
getSymbolicLinkStatus "nonEmpty"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures --
it "deleteDirRecursive, can't open parent directory" $ do
createDir' "noPerms/foo"
noPerms "noPerms"
(deleteDirRecursive' "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noPerms"
deleteDir' "noPerms/foo"
it "deleteDirRecursive, can't write to parent directory" $ do
createDir' "noWritable/foo"
noWritableDirPerms "noWritable"
(deleteDirRecursive' "noWritable/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noWritable"
deleteDir' "noWritable/foo"
it "deleteDirRecursive, wrong file type (symlink to directory)" $
deleteDirRecursive' "dirSym"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, wrong file type (regular file)" $
deleteDirRecursive' "file"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, directory does not exist" $
deleteDirRecursive' "doesNotExist"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)

View File

@ -1,114 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.DeleteDirSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Files.ByteString
(
getSymbolicLinkStatus
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteDirSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "file"
createDir' "dir"
createRegularFile' "dir/.keep"
createSymlink' "dirSym" "dir/"
createDir' "noPerms"
createRegularFile' "noPerms/.keep"
createDir' "noWritable"
createRegularFile' "noWritable/.keep"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "file"
deleteFile' "dir/.keep"
deleteDir' "dir"
deleteFile' "dirSym"
deleteFile' "noPerms/.keep"
deleteDir' "noPerms"
deleteFile' "noWritable/.keep"
deleteDir' "noWritable"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.deleteDir" $ do
-- successes --
it "deleteDir, empty directory, all fine" $ do
createDir' "testDir"
deleteDir' "testDir"
getSymbolicLinkStatus "testDir"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory with null permissions, all fine" $ do
createDir' "noPerms/testDir"
noPerms "noPerms/testDir"
deleteDir' "noPerms/testDir"
getSymbolicLinkStatus "testDir"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures --
it "deleteDir, wrong file type (symlink to directory)" $
deleteDir' "dirSym"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDir, wrong file type (regular file)" $
deleteDir' "file"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDir, directory does not exist" $
deleteDir' "doesNotExist"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory not empty" $
deleteDir' "dir"
`shouldThrow`
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
it "deleteDir, can't open parent directory" $ do
createDir' "noPerms/foo"
noPerms "noPerms"
(deleteDir' "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noPerms"
deleteDir' "noPerms/foo"
it "deleteDir, can't write to parent directory, still fine" $ do
createDir' "noWritable/foo"
noWritableDirPerms "noWritable"
(deleteDir' "noWritable/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noWritable"
deleteDir' "noWritable/foo"

View File

@ -1,84 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.DeleteFileSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Files.ByteString
(
getSymbolicLinkStatus
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "foo"
createSymlink' "syml" "foo"
createDir' "dir"
createDir' "noPerms"
noPerms "noPerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
deleteFile' "foo"
deleteFile' "syml"
deleteDir' "dir"
deleteDir' "noPerms"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.deleteFile" $ do
-- successes --
it "deleteFile, regular file, all fine" $ do
createRegularFile' "testFile"
deleteFile' "testFile"
getSymbolicLinkStatus "testFile"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, symlink, all fine" $ do
recreateSymlink' "syml"
"testFile"
Strict
deleteFile' "testFile"
getSymbolicLinkStatus "testFile"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures --
it "deleteFile, wrong file type (directory)" $
deleteFile' "dir"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType || ioeGetErrorType e == PermissionDenied)
it "deleteFile, file does not exist" $
deleteFile' "doesNotExist"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, can't read directory" $
deleteFile' "noPerms/blah"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@ -1,100 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.GetDirsFilesSpec where
import Data.List
(
sort
)
import "hpath-directory" System.Posix.RawFilePath.Directory hiding (getDirsFiles')
import System.Posix.FilePath
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "GetDirsFilesSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "file"
createRegularFile' "Lala"
createRegularFile' ".hidden"
createSymlink' "syml" "Lala"
createDir' "dir"
createSymlink' "dirsym" "dir"
createDir' "noPerms"
noPerms "noPerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
deleteFile' "file"
deleteFile' "Lala"
deleteFile' ".hidden"
deleteFile' "syml"
deleteDir' "dir"
deleteFile' "dirsym"
deleteDir' "noPerms"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.getDirsFiles" $ do
-- successes --
it "getDirsFiles, all fine" $
withRawTmpDir $ \p -> do
let expectedFiles = [".hidden"
,"Lala"
,"dir"
,"dirsym"
,"file"
,"noPerms"
,"syml"]
(fmap sort $ getDirsFiles p)
`shouldReturn` fmap (p </>) expectedFiles
-- posix failures --
it "getDirsFiles, nonexistent directory" $
getDirsFiles' "nothingHere"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "getDirsFiles, wrong file type (file)" $
getDirsFiles' "file"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "getDirsFiles, wrong file type (symlink to file)" $
getDirsFiles' "syml"
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "getDirsFiles, wrong file type (symlink to dir)" $
getDirsFiles' "dirsym"
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "getDirsFiles, can't open directory" $
getDirsFiles' "noPerms"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@ -1,88 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.GetFileTypeSpec where
import "hpath-directory" System.Posix.RawFilePath.Directory
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "GetFileTypeSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "regularfile"
createSymlink' "symlink" "regularfile"
createSymlink' "brokenSymlink" "broken"
createDir' "directory"
createSymlink' "symlinkD" "directory"
createDir' "noPerms"
noPerms "noPerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
deleteFile' "regularfile"
deleteFile' "symlink"
deleteFile' "brokenSymlink"
deleteDir' "directory"
deleteFile' "symlinkD"
deleteDir' "noPerms"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.getFileType" $ do
-- successes --
it "getFileType, regular file" $
getFileType' "regularfile"
`shouldReturn` RegularFile
it "getFileType, directory" $
getFileType' "directory"
`shouldReturn` Directory
it "getFileType, directory with null permissions" $
getFileType' "noPerms"
`shouldReturn` Directory
it "getFileType, symlink to file" $
getFileType' "symlink"
`shouldReturn` SymbolicLink
it "getFileType, symlink to directory" $
getFileType' "symlinkD"
`shouldReturn` SymbolicLink
it "getFileType, broken symlink" $
getFileType' "brokenSymlink"
`shouldReturn` SymbolicLink
-- posix failures --
it "getFileType, file does not exist" $
getFileType' "nothingHere"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "getFileType, can't open directory" $
getFileType' "noPerms/forz"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@ -1,126 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.MoveFileOverwriteSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "MoveFileOverwriteSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.moveFile" $ do
-- successes --
it "moveFile (Overwrite), all fine" $
moveFile' "myFile"
"movedFile"
Overwrite
it "moveFile (Overwrite), all fine" $
moveFile' "myFile"
"dir/movedFile"
Overwrite
it "moveFile (Overwrite), all fine on symlink" $
moveFile' "myFileL"
"movedFile"
Overwrite
it "moveFile (Overwrite), all fine on directory" $
moveFile' "dir"
"movedFile"
Overwrite
it "moveFile (Overwrite), destination file already exists" $
moveFile' "myFile"
"alreadyExists"
Overwrite
-- posix failures --
it "moveFile (Overwrite), source file does not exist" $
moveFile' "fileDoesNotExist"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "moveFile (Overwrite), can't write to destination directory" $
moveFile' "myFile"
"noWritePerm/movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile (Overwrite), can't open destination directory" $
moveFile' "myFile"
"noPerms/movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile (Overwrite), can't open source directory" $
moveFile' "noPerms/myFile"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "moveFile (Overwrite), move from file to dir" $
moveFile' "myFile"
"alreadyExistsD"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "moveFile (Overwrite), source and dest are same file" $
moveFile' "myFile"
"myFile"
Overwrite
`shouldThrow`
isSameFile

View File

@ -1,129 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.MoveFileSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "MoveFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.moveFile" $ do
-- successes --
it "moveFile (Strict), all fine" $
moveFile' "myFile"
"movedFile"
Strict
it "moveFile (Strict), all fine" $
moveFile' "myFile"
"dir/movedFile"
Strict
it "moveFile (Strict), all fine on symlink" $
moveFile' "myFileL"
"movedFile"
Strict
it "moveFile (Strict), all fine on directory" $
moveFile' "dir"
"movedFile"
Strict
-- posix failures --
it "moveFile (Strict), source file does not exist" $
moveFile' "fileDoesNotExist"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "moveFile (Strict), can't write to destination directory" $
moveFile' "myFile"
"noWritePerm/movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile (Strict), can't open destination directory" $
moveFile' "myFile"
"noPerms/movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile (Strict), can't open source directory" $
moveFile' "noPerms/myFile"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "moveFile (Strict), destination file already exists" $
moveFile' "myFile"
"alreadyExists"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "moveFile (Strict), move from file to dir" $
moveFile' "myFile"
"alreadyExistsD"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "moveFile (Strict), source and dest are same file" $
moveFile' "myFile"
"myFile"
Strict
`shouldThrow`
isSameFile

View File

@ -1,85 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.ReadFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "ReadFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.readFile" $ do
-- successes --
it "readFile (Strict) file with content, everything clear" $ do
out <- readFile' "fileWithContent"
out `shouldBe` "Blahfaselgagaga"
it "readFile (Strict) symlink, everything clear" $ do
out <- readFile' "inputFileSymL"
out `shouldBe` "Blahfaselgagaga"
it "readFile (Strict) empty file, everything clear" $ do
out <- readFile' "fileWithoutContent"
out `shouldBe` ""
-- posix failures --
it "readFile (Strict) directory, wrong file type" $ do
readFile' "alreadyExistsD"
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "readFile (Strict) file, no permissions" $ do
readFile' "noPerms"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFile (Strict) file, no permissions on dir" $ do
readFile' "noPermsD/inputFile"
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "readFile (Strict) file, no such file" $ do
readFile' "lalala"
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@ -1,139 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.RecreateSymlinkOverwriteSpec where
-- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RecreateSymlinkOverwriteSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
createDir' "alreadyExistsD2"
createRegularFile' "alreadyExistsD2/lala"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteFile' "alreadyExistsD2/lala"
deleteDir' "alreadyExistsD"
deleteDir' "alreadyExistsD2"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.recreateSymlink" $ do
-- successes --
it "recreateSymLink (Overwrite), all fine" $ do
recreateSymlink' "myFileL"
"movedFile"
Overwrite
removeFileIfExists "movedFile"
it "recreateSymLink (Overwrite), all fine" $ do
recreateSymlink' "myFileL"
"dir/movedFile"
Overwrite
removeFileIfExists "dir/movedFile"
it "recreateSymLink (Overwrite), destination file already exists" $
recreateSymlink' "myFileL"
"alreadyExists"
Overwrite
it "recreateSymLink (Overwrite), destination already exists and is an empty dir" $ do
recreateSymlink' "myFileL"
"alreadyExistsD"
Overwrite
deleteFile' "alreadyExistsD"
createDir' "alreadyExistsD"
-- posix failures --
it "recreateSymLink (Overwrite), destination already exists and is a non-empty dir" $
recreateSymlink' "myFileL"
"alreadyExistsD2"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
it "recreateSymLink (Overwrite), wrong input type (file)" $
recreateSymlink' "myFile"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink (Overwrite), wrong input type (directory)" $
recreateSymlink' "dir"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink (Overwrite), can't write to destination directory" $
recreateSymlink' "myFileL"
"noWritePerm/movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Overwrite), can't open destination directory" $
recreateSymlink' "myFileL"
"noPerms/movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Overwrite), can't open source directory" $
recreateSymlink' "noPerms/myFileL"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "recreateSymLink (Overwrite), source and destination are the same file" $
recreateSymlink' "myFileL"
"myFileL"
Overwrite
`shouldThrow`
isSameFile

View File

@ -1,130 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.RecreateSymlinkSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RecreateSymlinkSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.recreateSymlink" $ do
-- successes --
it "recreateSymLink (Strict), all fine" $ do
recreateSymlink' "myFileL"
"movedFile"
Strict
removeFileIfExists "movedFile"
it "recreateSymLink (Strict), all fine" $ do
recreateSymlink' "myFileL"
"dir/movedFile"
Strict
removeFileIfExists "dir/movedFile"
-- posix failures --
it "recreateSymLink (Strict), wrong input type (file)" $
recreateSymlink' "myFile"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink (Strict), wrong input type (directory)" $
recreateSymlink' "dir"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink (Strict), can't write to destination directory" $
recreateSymlink' "myFileL"
"noWritePerm/movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Strict), can't open destination directory" $
recreateSymlink' "myFileL"
"noPerms/movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Strict), can't open source directory" $
recreateSymlink' "noPerms/myFileL"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Strict), destination file already exists" $
recreateSymlink' "myFileL"
"alreadyExists"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "recreateSymLink (Strict), destination already exists and is a dir" $
recreateSymlink' "myFileL"
"alreadyExistsD"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures --
it "recreateSymLink (Strict), source and destination are the same file" $
recreateSymlink' "myFileL"
"myFileL"
Strict
`shouldThrow`
isSameFile

View File

@ -1,117 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.RenameFileSpec where
import Test.Hspec
import System.Posix.RawFilePath.Directory.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RenameFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.renameFile" $ do
-- successes --
it "renameFile, all fine" $
renameFile' "myFile"
"renamedFile"
it "renameFile, all fine" $
renameFile' "myFile"
"dir/renamedFile"
it "renameFile, all fine on symlink" $
renameFile' "myFileL"
"renamedFile"
it "renameFile, all fine on directory" $
renameFile' "dir"
"renamedFile"
-- posix failures --
it "renameFile, source file does not exist" $
renameFile' "fileDoesNotExist"
"renamedFile"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "renameFile, can't write to output directory" $
renameFile' "myFile"
"noWritePerm/renamedFile"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "renameFile, can't open output directory" $
renameFile' "myFile"
"noPerms/renamedFile"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "renameFile, can't open source directory" $
renameFile' "noPerms/myFile"
"renamedFile"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "renameFile, destination file already exists" $
renameFile' "myFile"
"alreadyExists"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "renameFile, move from file to dir" $
renameFile' "myFile"
"alreadyExistsD"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "renameFile, source and dest are same file" $
renameFile' "myFile"
"myFile"
`shouldThrow`
isSameFile

View File

@ -1,26 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.ToAbsSpec where
import Test.Hspec
import "hpath-directory" System.Posix.RawFilePath.Directory
spec :: Spec
spec = describe "System.Posix.RawFilePath.Directory.toAbs" $ do
-- successes --
it "toAbs returns absolute paths unchanged" $ do
let p1 = "/a/b/c/d"
to <- toAbs p1
p1 `shouldBe` to
it "toAbs returns even existing absolute paths unchanged" $ do
let p1 = "/home"
to <- toAbs p1
p1 `shouldBe` to

View File

@ -1,108 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.WriteFileLSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "WriteFileLSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.WriteFileL" $ do
-- successes --
it "WriteFileL file with content, everything clear" $ do
writeFileL' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "blahfaselllll"
it "WriteFileL file with content, everything clear" $ do
writeFileL' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "gagagaga"
it "WriteFileL file with content, everything clear" $ do
writeFileL' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` ""
it "WriteFileL file without content, everything clear" $ do
writeFileL' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "WriteFileL, everything clear" $ do
writeFileL' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "gagagaga"
it "WriteFileL symlink, everything clear" $ do
writeFileL' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "blahfaselllll"
it "WriteFileL symlink, everything clear" $ do
writeFileL' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "gagagaga"
-- posix failures --
it "WriteFileL to dir, inappropriate type" $ do
writeFileL' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "WriteFileL, no permissions to file" $ do
writeFileL' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "WriteFileL, no permissions to file" $ do
writeFileL' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "WriteFileL, file does not exist" $ do
writeFileL' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@ -1,108 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module System.Posix.RawFilePath.Directory.WriteFileSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "WriteFileSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createRegularFile' "fileWithContent"
createRegularFile' "fileWithoutContent"
createSymlink' "inputFileSymL" "fileWithContent"
createDir' "alreadyExistsD"
createRegularFile' "noPerms"
noPerms "noPerms"
createDir' "noPermsD"
createRegularFile' "noPermsD/inputFile"
noPerms "noPermsD"
writeFile' "fileWithContent" "BLKASL"
cleanupFiles :: IO ()
cleanupFiles = do
deleteFile' "fileWithContent"
deleteFile' "fileWithoutContent"
deleteFile' "inputFileSymL"
deleteDir' "alreadyExistsD"
normalFilePerms "noPerms"
deleteFile' "noPerms"
normalDirPerms "noPermsD"
deleteFile' "noPermsD/inputFile"
deleteDir' "noPermsD"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "System.Posix.RawFilePath.Directory.writeFile" $ do
-- successes --
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" "blahfaselllll"
out <- readFile' "fileWithContent"
out `shouldBe` "blahfaselllll"
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" "gagagaga"
out <- readFile' "fileWithContent"
out `shouldBe` "gagagaga"
it "writeFile file with content, everything clear" $ do
writeFile' "fileWithContent" ""
out <- readFile' "fileWithContent"
out `shouldBe` ""
it "writeFile file without content, everything clear" $ do
writeFile' "fileWithoutContent" "blahfaselllll"
out <- readFile' "fileWithoutContent"
out `shouldBe` "blahfaselllll"
it "writeFile, everything clear" $ do
writeFile' "fileWithoutContent" "gagagaga"
out <- readFile' "fileWithoutContent"
out `shouldBe` "gagagaga"
it "writeFile symlink, everything clear" $ do
writeFile' "inputFileSymL" "blahfaselllll"
out <- readFile' "inputFileSymL"
out `shouldBe` "blahfaselllll"
it "writeFile symlink, everything clear" $ do
writeFile' "inputFileSymL" "gagagaga"
out <- readFile' "inputFileSymL"
out `shouldBe` "gagagaga"
-- posix failures --
it "writeFile to dir, inappropriate type" $ do
writeFile' "alreadyExistsD" ""
`shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)
it "writeFile, no permissions to file" $ do
writeFile' "noPerms" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "writeFile, no permissions to file" $ do
writeFile' "noPermsD/inputFile" ""
`shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)
it "writeFile, file does not exist" $ do
writeFile' "gaga" ""
`shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)

View File

@ -1,293 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module Utils where
import Control.Applicative
(
(<$>)
)
import Control.Monad
(
forM_
, void
)
import Control.Monad.IfElse
(
whenM
)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.IORef
(
newIORef
, readIORef
, writeIORef
, IORef
)
import "hpath-directory" System.Posix.RawFilePath.Directory
import Prelude hiding (appendFile, readFile, writeFile)
import Data.Maybe
(
fromJust
)
import System.IO.Unsafe
(
unsafePerformIO
)
import qualified System.Posix.RawFilePath.Directory.Traversals as DT
import Data.ByteString
(
ByteString
)
import qualified Data.ByteString.Lazy as L
import System.Posix.FilePath
import System.Posix.Files.ByteString
(
groupExecuteMode
, groupReadMode
, nullFileMode
, otherExecuteMode
, otherReadMode
, ownerExecuteMode
, ownerReadMode
, setFileMode
, unionFileModes
)
baseTmpDir :: IORef (Maybe ByteString)
{-# NOINLINE baseTmpDir #-}
baseTmpDir = unsafePerformIO (newIORef Nothing)
tmpDir :: IORef (Maybe ByteString)
{-# NOINLINE tmpDir #-}
tmpDir = unsafePerformIO (newIORef Nothing)
-----------------
--[ Utilities ]--
-----------------
setTmpDir :: ByteString -> IO ()
{-# NOINLINE setTmpDir #-}
setTmpDir bs = do
tmp <- fromJust <$> readIORef baseTmpDir
writeIORef tmpDir (Just (tmp `BS.append` bs))
createTmpDir :: IO ()
{-# NOINLINE createTmpDir #-}
createTmpDir = do
tmp <- fromJust <$> readIORef tmpDir
void $ createDir newDirPerms tmp
deleteTmpDir :: IO ()
{-# NOINLINE deleteTmpDir #-}
deleteTmpDir = do
tmp <- fromJust <$> readIORef tmpDir
void $ deleteDir tmp
deleteBaseTmpDir :: IO ()
{-# NOINLINE deleteBaseTmpDir #-}
deleteBaseTmpDir = do
tmp <- fromJust <$> readIORef baseTmpDir
contents <- getDirsFiles tmp
forM_ contents deleteDir
void $ deleteDir tmp
withRawTmpDir :: (ByteString -> IO a) -> IO a
{-# NOINLINE withRawTmpDir #-}
withRawTmpDir f = do
tmp <- fromJust <$> readIORef tmpDir
f tmp
getRawTmpDir :: IO ByteString
{-# NOINLINE getRawTmpDir #-}
getRawTmpDir = withRawTmpDir (return . flip BS.append "/")
withTmpDir :: ByteString -> (ByteString -> IO a) -> IO a
{-# NOINLINE withTmpDir #-}
withTmpDir ip f = do
tmp <- fromJust <$> readIORef tmpDir
let p = tmp </> ip
f p
withTmpDir' :: ByteString
-> ByteString
-> (ByteString -> ByteString -> IO a)
-> IO a
{-# NOINLINE withTmpDir' #-}
withTmpDir' ip1 ip2 f = do
tmp <- fromJust <$> readIORef tmpDir
let p1 = tmp </> ip1
let p2 = tmp </> ip2
f p1 p2
removeFileIfExists :: ByteString -> IO ()
{-# NOINLINE removeFileIfExists #-}
removeFileIfExists bs =
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p)
removeDirIfExists :: ByteString -> IO ()
{-# NOINLINE removeDirIfExists #-}
removeDirIfExists bs =
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()
{-# NOINLINE copyFile' #-}
copyFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm)
copyDirRecursive' :: ByteString -> ByteString
-> CopyMode -> RecursiveErrorMode -> IO ()
{-# NOINLINE copyDirRecursive' #-}
copyDirRecursive' inputDirP outputDirP cm rm =
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm)
createDir' :: ByteString -> IO ()
{-# NOINLINE createDir' #-}
createDir' dest = withTmpDir dest (createDir newDirPerms)
createDirIfMissing' :: ByteString -> IO ()
{-# NOINLINE createDirIfMissing' #-}
createDirIfMissing' dest = withTmpDir dest (createDirIfMissing newDirPerms)
createDirRecursive' :: ByteString -> IO ()
{-# NOINLINE createDirRecursive' #-}
createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms)
createRegularFile' :: ByteString -> IO ()
{-# NOINLINE createRegularFile' #-}
createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms)
createSymlink' :: ByteString -> ByteString -> IO ()
{-# NOINLINE createSymlink' #-}
createSymlink' dest sympoint = withTmpDir dest
(\x -> createSymlink x sympoint)
renameFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE renameFile' #-}
renameFile' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP $ \i o -> do
renameFile i o
renameFile o i
moveFile' :: ByteString -> ByteString -> CopyMode -> IO ()
{-# NOINLINE moveFile' #-}
moveFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP $ \i o -> do
moveFile i o cm
moveFile o i Strict
recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO ()
{-# NOINLINE recreateSymlink' #-}
recreateSymlink' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm)
noWritableDirPerms :: ByteString -> IO ()
{-# NOINLINE noWritableDirPerms #-}
noWritableDirPerms path = withTmpDir path $ \p ->
setFileMode p perms
where
perms = ownerReadMode
`unionFileModes` ownerExecuteMode
`unionFileModes` groupReadMode
`unionFileModes` groupExecuteMode
`unionFileModes` otherReadMode
`unionFileModes` otherExecuteMode
noPerms :: ByteString -> IO ()
{-# NOINLINE noPerms #-}
noPerms path = withTmpDir path $ \p -> setFileMode p nullFileMode
normalDirPerms :: ByteString -> IO ()
{-# NOINLINE normalDirPerms #-}
normalDirPerms path =
withTmpDir path $ \p -> setFileMode p newDirPerms
normalFilePerms :: ByteString -> IO ()
{-# NOINLINE normalFilePerms #-}
normalFilePerms path =
withTmpDir path $ \p -> setFileMode p newFilePerms
getFileType' :: ByteString -> IO FileType
{-# NOINLINE getFileType' #-}
getFileType' path = withTmpDir path getFileType
getDirsFiles' :: ByteString -> IO [ByteString]
{-# NOINLINE getDirsFiles' #-}
getDirsFiles' path = withTmpDir path getDirsFiles
deleteFile' :: ByteString -> IO ()
{-# NOINLINE deleteFile' #-}
deleteFile' p = withTmpDir p deleteFile
deleteDir' :: ByteString -> IO ()
{-# NOINLINE deleteDir' #-}
deleteDir' p = withTmpDir p deleteDir
deleteDirRecursive' :: ByteString -> IO ()
{-# NOINLINE deleteDirRecursive' #-}
deleteDirRecursive' p = withTmpDir p deleteDirRecursive
canonicalizePath' :: ByteString -> IO ByteString
{-# NOINLINE canonicalizePath' #-}
canonicalizePath' p = withTmpDir p canonicalizePath
writeFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE writeFile' #-}
writeFile' ip bs =
withTmpDir ip $ \p -> writeFile p Nothing bs
writeFileL' :: ByteString -> BSL.ByteString -> IO ()
{-# NOINLINE writeFileL' #-}
writeFileL' ip bs =
withTmpDir ip $ \p -> writeFileL p Nothing bs
appendFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE appendFile' #-}
appendFile' ip bs =
withTmpDir ip $ \p -> appendFile p bs
allDirectoryContents' :: ByteString -> IO [ByteString]
{-# NOINLINE allDirectoryContents' #-}
allDirectoryContents' ip =
withTmpDir ip $ \p -> DT.allDirectoryContents' p
readFile' :: ByteString -> IO ByteString
{-# NOINLINE readFile' #-}
readFile' p = withTmpDir p (fmap L.toStrict . readFile)

View File

@ -1,14 +0,0 @@
# Revision history for hpath-filepath
## 0.10.4 -- 2020-01-26
* Add `takeAllParents`
## 0.10.2 -- 2020-01-18
* Add `isSpecialDirectoryEntry`
## 0.10.0 -- 2020-01-04
* First version. Split from 'hpath', contains only the filepath ByteString manipulation parts.

View File

@ -1,30 +0,0 @@
Copyright (c) 2020, Julian Ospald
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Julian Ospald nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View File

@ -1,29 +0,0 @@
# HPath-filepath
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-filepath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-filepath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-filepath.svg)](http://packdeps.haskellers.com/feed?needle=hpath-filepath)
Support for bytestring based filepath manipulation, similar to 'filepath'.
This package is part of the HPath suite, also check out:
* [hpath](https://hackage.haskell.org/package/hpath)
* [hpath-directory](https://hackage.haskell.org/package/hpath-directory)
* [hpath-io](https://hackage.haskell.org/package/hpath-io)
## Motivation
This is basically a fork of [posix-paths](https://github.com/JohnLato/posix-paths), which seemed to have stalled development.
There is also a similar library [filepath-bytestring](https://hackage.haskell.org/package/filepath-bytestring), but it doesn't follow an open development model and is cross-platform, which this library is not interested in.
## Differences to 'posix-paths'
* uses the `word8` package for save word8 literals instead of `OverloadedStrings`
* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart
* has some additional functions
## Differences to 'filepath-bytestring'
* uses the `word8` package for save word8 literals instead of `OverloadedStrings`
* is not cross-platform (less odd code to maintain)
* has some additional functions

View File

@ -1,2 +0,0 @@
import Distribution.Simple
main = defaultMain

View File

@ -1,39 +0,0 @@
name: hpath-filepath
version: 0.10.4
synopsis: ByteString based filepath manipulation
description: ByteString based filepath manipulation, similar to 'filepath' package. This is POSIX only.
-- bug-reports:
license: BSD3
license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de>
maintainer: Julian Ospald <hasufell@posteo.de>
copyright: Julian Ospald 2016
category: Filesystem
build-type: Simple
cabal-version: 1.14
tested-with: GHC==7.10.3
, GHC==8.0.2
, GHC==8.2.2
, GHC==8.4.4
, GHC==8.6.5
, GHC==8.8.1
extra-source-files: README.md
CHANGELOG.md
library
if os(windows)
build-depends: unbuildable<0
buildable: False
exposed-modules: System.Posix.FilePath
-- other-modules:
-- other-extensions:
build-depends: base >=4.8 && <5
, bytestring >= 0.10.0.0
, unix >= 2.5
, word8
hs-source-dirs: src
default-language: Haskell2010
source-repository head
type: git
location: https://github.com/hasufell/hpath

View File

@ -1,23 +0,0 @@
#!/bin/sh
set -e
if [ -n "${SKIP_DOCTESTS}" ] ; then
echo "Skipping doctests"
exit 0
fi
if ! command -v doctest >/dev/null ; then
tempdir="$(mktemp -d)"
(
cd "${tempdir}"
cabal install --installdir="${tempdir}" doctest
)
export PATH="${tempdir}:$PATH"
fi
set -x
cd "$(CDPATH= cd -- "$(dirname -- "$0")" && pwd -P)"
cabal exec doctest -- -isrc -XOverloadedStrings System.Posix.FilePath

View File

@ -1,859 +0,0 @@
-- |
-- Module : System.Posix.FilePath
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- The equivalent of "System.FilePath" on raw (byte string) file paths.
--
-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}
module System.Posix.FilePath (
-- * Separator predicates
pathSeparator
, isPathSeparator
, searchPathSeparator
, isSearchPathSeparator
, extSeparator
, isExtSeparator
-- * $PATH methods
, splitSearchPath
, getSearchPath
-- * Extension functions
, splitExtension
, takeExtension
, replaceExtension
, dropExtension
, addExtension
, hasExtension
, (<.>)
, splitExtensions
, dropExtensions
, takeExtensions
, stripExtension
-- * Filename\/directory functions
, splitFileName
, takeFileName
, replaceFileName
, dropFileName
, takeBaseName
, replaceBaseName
, takeDirectory
, replaceDirectory
, combine
, (</>)
, splitPath
, joinPath
, splitDirectories
, takeAllParents
-- * Trailing slash functions
, hasTrailingPathSeparator
, addTrailingPathSeparator
, dropTrailingPathSeparator
-- * File name manipulations
, normalise
, makeRelative
, equalFilePath
, isRelative
, isAbsolute
, isValid
, makeValid
, isSpecialDirectoryEntry
, isFileName
, hasParentDir
, hiddenFile
, module System.Posix.ByteString.FilePath
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.String (fromString)
import System.Posix.ByteString.FilePath
import qualified System.Posix.Env.ByteString as PE
import Data.Maybe (isJust)
import Data.Word8
#if !MIN_VERSION_bytestring(0,10,8)
import qualified Data.List as L
#endif
import Control.Arrow (second)
-- $setup
-- >>> import Data.Char
-- >>> import Data.Maybe
-- >>> import Data.Word8
-- >>> import Test.QuickCheck
-- >>> import Control.Applicative
-- >>> import qualified Data.ByteString as BS
-- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary
-- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack
--
-- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral
------------------------
-- Separator predicates
-- | Path separator character
pathSeparator :: Word8
pathSeparator = _slash
-- | Check if a character is the path separator
--
-- prop> \n -> (_chr n == '/') == isPathSeparator n
isPathSeparator :: Word8 -> Bool
isPathSeparator = (== pathSeparator)
-- | Search path separator
searchPathSeparator :: Word8
searchPathSeparator = _colon
-- | Check if a character is the search path separator
--
-- prop> \n -> (_chr n == ':') == isSearchPathSeparator n
isSearchPathSeparator :: Word8 -> Bool
isSearchPathSeparator = (== searchPathSeparator)
-- | File extension separator
extSeparator :: Word8
extSeparator = _period
-- | Check if a character is the file extension separator
--
-- prop> \n -> (_chr n == '.') == isExtSeparator n
isExtSeparator :: Word8 -> Bool
isExtSeparator = (== extSeparator)
------------------------
-- $PATH methods
-- | Take a ByteString, split it on the 'searchPathSeparator'.
-- Blank items are converted to @.@.
--
-- Follows the recommendations in
-- <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
--
-- >>> splitSearchPath "File1:File2:File3"
-- ["File1","File2","File3"]
-- >>> splitSearchPath "File1::File2:File3"
-- ["File1",".","File2","File3"]
-- >>> splitSearchPath ""
-- ["."]
splitSearchPath :: ByteString -> [RawFilePath]
splitSearchPath = f
where
f bs = let (pre, post) = BS.break isSearchPathSeparator bs
in if BS.null post
then g pre
else g pre ++ f (BS.tail post)
g x
| BS.null x = [BS.singleton _period]
| otherwise = [x]
-- | Get a list of 'RawFilePath's in the $PATH variable.
getSearchPath :: IO [RawFilePath]
getSearchPath = fmap (maybe [] splitSearchPath) (PE.getEnv $ fromString "PATH")
------------------------
-- Extension functions
-- | Split a 'RawFilePath' into a path+filename and extension
--
-- >>> splitExtension "file.exe"
-- ("file",".exe")
-- >>> splitExtension "file"
-- ("file","")
-- >>> splitExtension "/path/file.tar.gz"
-- ("/path/file.tar",".gz")
--
-- prop> \path -> uncurry (BS.append) (splitExtension path) == path
splitExtension :: RawFilePath -> (RawFilePath, ByteString)
splitExtension x = if BS.null basename
then (x,BS.empty)
else (BS.append path (BS.init basename),BS.cons extSeparator fileExt)
where
(path,file) = splitFileNameRaw x
(basename,fileExt) = BS.breakEnd isExtSeparator file
-- | Get the final extension from a 'RawFilePath'
--
-- >>> takeExtension "file.exe"
-- ".exe"
-- >>> takeExtension "file"
-- ""
-- >>> takeExtension "/path/file.tar.gz"
-- ".gz"
takeExtension :: RawFilePath -> ByteString
takeExtension = snd . splitExtension
-- | Change a file's extension
--
-- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path
replaceExtension :: RawFilePath -> ByteString -> RawFilePath
replaceExtension path ext = dropExtension path <.> ext
-- | Drop the final extension from a 'RawFilePath'
--
-- >>> dropExtension "file.exe"
-- "file"
-- >>> dropExtension "file"
-- "file"
-- >>> dropExtension "/path/file.tar.gz"
-- "/path/file.tar"
dropExtension :: RawFilePath -> RawFilePath
dropExtension = fst . splitExtension
-- | Add an extension to a 'RawFilePath'
--
-- >>> addExtension "file" ".exe"
-- "file.exe"
-- >>> addExtension "file.tar" ".gz"
-- "file.tar.gz"
-- >>> addExtension "/path/" ".ext"
-- "/path/.ext"
addExtension :: RawFilePath -> ByteString -> RawFilePath
addExtension file ext
| BS.null ext = file
| isExtSeparator (BS.head ext) = BS.append file ext
| otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext]
-- | Check if a 'RawFilePath' has an extension
--
-- >>> hasExtension "file"
-- False
-- >>> hasExtension "file.tar"
-- True
-- >>> hasExtension "/path.part1/"
-- False
hasExtension :: RawFilePath -> Bool
hasExtension = isJust . BS.elemIndex extSeparator . takeFileName
-- | Operator version of 'addExtension'
(<.>) :: RawFilePath -> ByteString -> RawFilePath
(<.>) = addExtension
-- | Split a 'RawFilePath' on the first extension.
--
-- >>> splitExtensions "/path/file.tar.gz"
-- ("/path/file",".tar.gz")
--
-- prop> \path -> uncurry addExtension (splitExtensions path) == path
splitExtensions :: RawFilePath -> (RawFilePath, ByteString)
splitExtensions x = if BS.null basename
then (path,fileExt)
else (BS.append path basename,fileExt)
where
(path,file) = splitFileNameRaw x
(basename,fileExt) = BS.break isExtSeparator file
-- | Remove all extensions from a 'RawFilePath'
--
-- >>> dropExtensions "/path/file.tar.gz"
-- "/path/file"
dropExtensions :: RawFilePath -> RawFilePath
dropExtensions = fst . splitExtensions
-- | Take all extensions from a 'RawFilePath'
--
-- >>> takeExtensions "/path/file.tar.gz"
-- ".tar.gz"
takeExtensions :: RawFilePath -> ByteString
takeExtensions = snd . splitExtensions
-- | Drop the given extension from a FilePath, and the @\".\"@ preceding it.
-- Returns 'Nothing' if the FilePath does not have the given extension, or
-- 'Just' and the part before the extension if it does.
--
-- This function can be more predictable than 'dropExtensions',
-- especially if the filename might itself contain @.@ characters.
--
-- >>> stripExtension "hs.o" "foo.x.hs.o"
-- Just "foo.x"
-- >>> stripExtension "hi.o" "foo.x.hs.o"
-- Nothing
-- >>> stripExtension ".c.d" "a.b.c.d"
-- Just "a.b"
-- >>> stripExtension ".c.d" "a.b..c.d"
-- Just "a.b."
-- >>> stripExtension "baz" "foo.bar"
-- Nothing
-- >>> stripExtension "bar" "foobar"
-- Nothing
--
-- prop> \path -> stripExtension "" path == Just path
-- prop> \path -> dropExtension path == fromJust (stripExtension (takeExtension path) path)
-- prop> \path -> dropExtensions path == fromJust (stripExtension (takeExtensions path) path)
stripExtension :: ByteString -> RawFilePath -> Maybe RawFilePath
stripExtension bs path
| BS.null bs = Just path
| otherwise = stripSuffix' dotExt path
where
dotExt = if isExtSeparator $ BS.head bs
then bs
else extSeparator `BS.cons` bs
#if MIN_VERSION_bytestring(0,10,8)
stripSuffix' = BS.stripSuffix
#else
stripSuffix' xs ys = fmap (BS.pack . reverse) $ L.stripPrefix (reverse $ BS.unpack xs) (reverse $ BS.unpack ys)
#endif
------------------------
-- Filename/directory functions
-- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse
--
-- >>> splitFileName "path/file.txt"
-- ("path/","file.txt")
-- >>> splitFileName "path/"
-- ("path/","")
-- >>> splitFileName "file.txt"
-- ("./","file.txt")
--
-- prop> \path -> uncurry combine (splitFileName path) == path || fst (splitFileName path) == "./"
splitFileName :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileName x = if BS.null path
then (dotSlash, file)
else (path,file)
where
(path,file) = splitFileNameRaw x
dotSlash = _period `BS.cons` (BS.singleton pathSeparator)
-- | Get the file name
--
-- >>> takeFileName "path/file.txt"
-- "file.txt"
-- >>> takeFileName "path/"
-- ""
takeFileName :: RawFilePath -> RawFilePath
takeFileName = snd . splitFileName
-- | Change the file name
--
-- prop> \path -> replaceFileName path (takeFileName path) == path
replaceFileName :: RawFilePath -> ByteString -> RawFilePath
replaceFileName x y = fst (splitFileNameRaw x) </> y
-- | Drop the file name
--
-- >>> dropFileName "path/file.txt"
-- "path/"
-- >>> dropFileName "file.txt"
-- "./"
dropFileName :: RawFilePath -> RawFilePath
dropFileName = fst . splitFileName
-- | Get the file name, without a trailing extension
--
-- >>> takeBaseName "path/file.tar.gz"
-- "file.tar"
-- >>> takeBaseName ""
-- ""
takeBaseName :: RawFilePath -> ByteString
takeBaseName = dropExtension . takeFileName
-- | Change the base name
--
-- >>> replaceBaseName "path/file.tar.gz" "bob"
-- "path/bob.gz"
--
-- prop> \path -> replaceBaseName path (takeBaseName path) == path
replaceBaseName :: RawFilePath -> ByteString -> RawFilePath
replaceBaseName path name = combineRaw dir (name <.> ext)
where
(dir,file) = splitFileNameRaw path
ext = takeExtension file
-- | Get the directory, moving up one level if it's already a directory
--
-- >>> takeDirectory "path/file.txt"
-- "path"
-- >>> takeDirectory "file"
-- "."
-- >>> takeDirectory "/path/to/"
-- "/path/to"
-- >>> takeDirectory "/path/to"
-- "/path"
takeDirectory :: RawFilePath -> RawFilePath
takeDirectory x = case () of
() | x == BS.singleton pathSeparator -> x
| BS.null res && not (BS.null file) -> file
| otherwise -> res
where
res = fst $ BS.spanEnd isPathSeparator file
file = dropFileName x
-- | Change the directory component of a 'RawFilePath'
--
-- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "."
replaceDirectory :: RawFilePath -> ByteString -> RawFilePath
replaceDirectory file dir = combineRaw dir (takeFileName file)
-- | Join two paths together
--
-- >>> combine "/" "file"
-- "/file"
-- >>> combine "/path/to" "file"
-- "/path/to/file"
-- >>> combine "file" "/absolute/path"
-- "/absolute/path"
combine :: RawFilePath -> RawFilePath -> RawFilePath
combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b
| otherwise = combineRaw a b
-- | Operator version of combine
(</>) :: RawFilePath -> RawFilePath -> RawFilePath
(</>) = combine
-- | Split a path into a list of components:
--
-- >>> splitPath "/path/to/file.txt"
-- ["/","path/","to/","file.txt"]
--
-- prop> \path -> BS.concat (splitPath path) == path
splitPath :: RawFilePath -> [RawFilePath]
splitPath = splitter
where
splitter x
| BS.null x = []
| otherwise = case BS.elemIndex pathSeparator x of
Nothing -> [x]
Just ix -> case BS.findIndex (not . isPathSeparator) $ BS.drop (ix+1) x of
Nothing -> [x]
Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x
-- | Join a split path back together
--
-- prop> \path -> joinPath (splitPath path) == path
--
-- >>> joinPath ["path","to","file.txt"]
-- "path/to/file.txt"
joinPath :: [RawFilePath] -> RawFilePath
joinPath = foldr (</>) BS.empty
-- | Like 'splitPath', but without trailing slashes
--
-- >>> splitDirectories "/path/to/file.txt"
-- ["/","path","to","file.txt"]
-- >>> splitDirectories "path/to/file.txt"
-- ["path","to","file.txt"]
-- >>> splitDirectories ""
-- []
splitDirectories :: RawFilePath -> [RawFilePath]
splitDirectories x
| BS.null x = []
| isPathSeparator (BS.head x) = let (root,rest) = BS.splitAt 1 x
in root : splitter rest
| otherwise = splitter x
where
splitter = filter (not . BS.null) . BS.split pathSeparator
-- |Get all parents of a path.
--
-- >>> takeAllParents "/abs/def/dod"
-- ["/abs/def","/abs","/"]
-- >>> takeAllParents "/foo"
-- ["/"]
-- >>> takeAllParents "/"
-- []
takeAllParents :: RawFilePath -> [RawFilePath]
takeAllParents p
| np == BS.singleton pathSeparator = []
| otherwise = takeDirectory np : takeAllParents (takeDirectory np)
where
np = normalise p
------------------------
-- Trailing slash functions
-- | Check if the last character of a 'RawFilePath' is '/'.
--
-- >>> hasTrailingPathSeparator "/path/"
-- True
-- >>> hasTrailingPathSeparator "/"
-- True
-- >>> hasTrailingPathSeparator "/path"
-- False
hasTrailingPathSeparator :: RawFilePath -> Bool
hasTrailingPathSeparator x
| BS.null x = False
| otherwise = isPathSeparator $ BS.last x
-- | Add a trailing path separator.
--
-- >>> addTrailingPathSeparator "/path"
-- "/path/"
-- >>> addTrailingPathSeparator "/path/"
-- "/path/"
-- >>> addTrailingPathSeparator "/"
-- "/"
addTrailingPathSeparator :: RawFilePath -> RawFilePath
addTrailingPathSeparator x = if hasTrailingPathSeparator x
then x
else x `BS.snoc` pathSeparator
-- | Remove a trailing path separator
--
-- >>> dropTrailingPathSeparator "/path/"
-- "/path"
-- >>> dropTrailingPathSeparator "/path////"
-- "/path"
-- >>> dropTrailingPathSeparator "/"
-- "/"
-- >>> dropTrailingPathSeparator "//"
-- "/"
dropTrailingPathSeparator :: RawFilePath -> RawFilePath
dropTrailingPathSeparator x
| x == BS.singleton pathSeparator = x
| otherwise = if hasTrailingPathSeparator x
then dropTrailingPathSeparator $ BS.init x
else x
------------------------
-- File name manipulations
-- |Normalise a file.
--
-- >>> normalise "/file/\\test////"
-- "/file/\\test/"
-- >>> normalise "/file/./test"
-- "/file/test"
-- >>> normalise "/test/file/../bob/fred/"
-- "/test/file/../bob/fred/"
-- >>> normalise "../bob/fred/"
-- "../bob/fred/"
-- >>> normalise "./bob/fred/"
-- "bob/fred/"
-- >>> normalise "./bob////.fred/./...///./..///#."
-- "bob/.fred/.../../#."
-- >>> normalise "."
-- "."
-- >>> normalise "./"
-- "./"
-- >>> normalise "./."
-- "./"
-- >>> normalise "/./"
-- "/"
-- >>> normalise "/"
-- "/"
-- >>> normalise "bob/fred/."
-- "bob/fred/"
-- >>> normalise "//home"
-- "/home"
normalise :: RawFilePath -> RawFilePath
normalise filepath =
result `BS.append`
(if addPathSeparator
then BS.singleton pathSeparator
else BS.empty)
where
result = let n = f filepath
in if BS.null n
then BS.singleton _period
else n
addPathSeparator = isDirPath filepath &&
not (hasTrailingPathSeparator result)
isDirPath xs = hasTrailingPathSeparator xs
|| not (BS.null xs) && BS.last xs == _period
&& hasTrailingPathSeparator (BS.init xs)
f = joinPath . dropDots . propSep . splitDirectories
propSep :: [ByteString] -> [ByteString]
propSep (x:xs)
| BS.all (== pathSeparator) x = BS.singleton pathSeparator : xs
| otherwise = x : xs
propSep [] = []
dropDots :: [ByteString] -> [ByteString]
dropDots = filter (BS.singleton _period /=)
-- | Contract a filename, based on a relative path. Note that the resulting
-- path will never introduce @..@ paths, as the presence of symlinks
-- means @..\/b@ may not reach @a\/b@ if it starts from @a\/c@. For a
-- worked example see
-- <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.
--
-- >>> makeRelative "/directory" "/directory/file.ext"
-- "file.ext"
-- >>> makeRelative "/Home" "/home/bob"
-- "/home/bob"
-- >>> makeRelative "/home/" "/home/bob/foo/bar"
-- "bob/foo/bar"
-- >>> makeRelative "/fred" "bob"
-- "bob"
-- >>> makeRelative "/file/test" "/file/test/fred"
-- "fred"
-- >>> makeRelative "/file/test" "/file/test/fred/"
-- "fred/"
-- >>> makeRelative "some/path" "some/path/a/b/c"
-- "a/b/c"
--
-- prop> \p -> makeRelative p p == "."
-- prop> \p -> makeRelative (takeDirectory p) p `equalFilePath` takeFileName p
-- prop \x y -> equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
makeRelative :: RawFilePath -> RawFilePath -> RawFilePath
makeRelative root path
| equalFilePath root path = BS.singleton _period
| takeAbs root /= takeAbs path = path
| otherwise = f (dropAbs root) (dropAbs path)
where
f x y
| BS.null x = BS.dropWhile isPathSeparator y
| otherwise = let (x1,x2) = g x
(y1,y2) = g y
in if equalFilePath x1 y1 then f x2 y2 else path
g x = (BS.dropWhile isPathSeparator a, BS.dropWhile isPathSeparator b)
where (a, b) = BS.break isPathSeparator $ BS.dropWhile isPathSeparator x
dropAbs x = snd $ BS.span (== _slash) x
takeAbs x = fst $ BS.span (== _slash) x
-- |Equality of two filepaths. The filepaths are normalised
-- and trailing path separators are dropped.
--
-- >>> equalFilePath "foo" "foo"
-- True
-- >>> equalFilePath "foo" "foo/"
-- True
-- >>> equalFilePath "foo" "./foo"
-- True
-- >>> equalFilePath "" ""
-- True
-- >>> equalFilePath "foo" "/foo"
-- False
-- >>> equalFilePath "foo" "FOO"
-- False
-- >>> equalFilePath "foo" "../foo"
-- False
--
-- prop> \p -> equalFilePath p p
equalFilePath :: RawFilePath -> RawFilePath -> Bool
equalFilePath p1 p2 = f p1 == f p2
where
f x = dropTrailingPathSeparator $ normalise x
-- | Check if a path is relative
--
-- prop> \path -> isRelative path /= isAbsolute path
isRelative :: RawFilePath -> Bool
isRelative = not . isAbsolute
-- | Check if a path is absolute
--
-- >>> isAbsolute "/path"
-- True
-- >>> isAbsolute "path"
-- False
-- >>> isAbsolute ""
-- False
isAbsolute :: RawFilePath -> Bool
isAbsolute x
| BS.length x > 0 = isPathSeparator (BS.head x)
| otherwise = False
-- | Is a FilePath valid, i.e. could you create a file like it?
--
-- >>> isValid ""
-- False
-- >>> isValid "\0"
-- False
-- >>> isValid "/random_ path:*"
-- True
isValid :: RawFilePath -> Bool
isValid filepath
| BS.null filepath = False
| _nul `BS.elem` filepath = False
| otherwise = True
-- | Take a FilePath and make it valid; does not change already valid FilePaths.
--
-- >>> makeValid ""
-- "_"
-- >>> makeValid "file\0name"
-- "file_name"
--
-- prop> \p -> if isValid p then makeValid p == p else makeValid p /= p
-- prop> \p -> isValid (makeValid p)
makeValid :: RawFilePath -> RawFilePath
makeValid path
| BS.null path = BS.singleton _underscore
| otherwise = BS.map (\x -> if x == _nul then _underscore else x) path
-- | Whether the filename is a special directory entry
-- (. and ..). Does not normalise filepaths.
--
-- >>> isSpecialDirectoryEntry "."
-- True
-- >>> isSpecialDirectoryEntry ".."
-- True
-- >>> isSpecialDirectoryEntry "/random_ path:*"
-- False
isSpecialDirectoryEntry :: RawFilePath -> Bool
isSpecialDirectoryEntry filepath
| BS.pack [_period, _period] == filepath = True
| BS.pack [_period] == filepath = True
| otherwise = False
-- | Is the given path a valid filename? This includes
-- "." and "..".
--
-- >>> isFileName "lal"
-- True
-- >>> isFileName "."
-- True
-- >>> isFileName ".."
-- True
-- >>> isFileName ""
-- False
-- >>> isFileName "\0"
-- False
-- >>> isFileName "/random_ path:*"
-- False
isFileName :: RawFilePath -> Bool
isFileName filepath =
not (BS.singleton pathSeparator `BS.isInfixOf` filepath) &&
not (BS.null filepath) &&
not (_nul `BS.elem` filepath)
-- | Check if the filepath has any parent directories in it.
--
-- >>> hasParentDir "/.."
-- True
-- >>> hasParentDir "foo/bar/.."
-- True
-- >>> hasParentDir "foo/../bar/."
-- True
-- >>> hasParentDir "foo/bar"
-- False
-- >>> hasParentDir "foo"
-- False
-- >>> hasParentDir ""
-- False
-- >>> hasParentDir ".."
-- False
hasParentDir :: RawFilePath -> Bool
hasParentDir filepath =
(pathSeparator `BS.cons` pathDoubleDot)
`BS.isSuffixOf` filepath
||
(BS.singleton pathSeparator
`BS.append` pathDoubleDot
`BS.append` BS.singleton pathSeparator)
`BS.isInfixOf` filepath
||
(pathDoubleDot `BS.append` BS.singleton pathSeparator)
`BS.isPrefixOf` filepath
where
pathDoubleDot = BS.pack [_period, _period]
-- | Whether the file is a hidden file.
--
-- >>> hiddenFile ".foo"
-- True
-- >>> hiddenFile "..foo.bar"
-- True
-- >>> hiddenFile "some/path/.bar"
-- True
-- >>> hiddenFile "..."
-- True
-- >>> hiddenFile "dod.bar"
-- False
-- >>> hiddenFile "."
-- False
-- >>> hiddenFile ".."
-- False
-- >>> hiddenFile ""
-- False
hiddenFile :: RawFilePath -> Bool
hiddenFile fp
| fn == BS.pack [_period, _period] = False
| fn == BS.pack [_period] = False
| otherwise = BS.pack [extSeparator]
`BS.isPrefixOf` fn
where
fn = takeFileName fp
------------------------
-- internal stuff
-- Just split the input FileName without adding/normalizing or changing
-- anything.
splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw = BS.breakEnd isPathSeparator
-- | Combine two paths, assuming rhs is NOT absolute.
combineRaw :: RawFilePath -> RawFilePath -> RawFilePath
combineRaw a b | BS.null a = b
| BS.null b = a
| isPathSeparator (BS.last a) = BS.append a b
| otherwise = BS.intercalate (BS.singleton pathSeparator) [a, b]

View File

@ -1,47 +0,0 @@
# Revision history for hpath-io
## 0.13.2 -- 2020-05-08
* Add getDirsFilesStream and use streamly-posix for dircontents (#34)
## 0.13.0 -- 2020-01-26
* switch to using 'hpath-bytestring' for the implementation (this is now just a wrapper module, mostly)
## 0.12.0 -- 2020-01-20
* breaking API changes
* RelC and Fn were removed from `hpath`
* further changes to `parseAny`
## 0.11.0 -- 2020-01-18
* `writeFile` not allows to set file mode and create file if it does not exist (this broke API)
* added various new functions:
* createDirIfMissing
* writeFileL (for lazy bytestring)
* isReadable
* isExecutable
* getModificationTime
* setModificationTime
* setModificationTimeHiRes
* getDirsFiles' (returns filenames instead of paths)
* withRawFilePath
* withHandle
## 0.10.1 -- 2020-01-13
* Move file check functions to HPath.IO
* Add 'doesExist'
* Exception handling of `doesExist`, `doesFileExist`, `doesDirectoryExist` has changed: only eNOENT is catched
* Exception handling of `isWritable` has changed: just a wrapper around `access` now
* switch exception handling to `safe-exceptions`
* Redo file reading API (readFileEOF dropped and now using streamly under the hood, added `readFileStream`)
## 0.10.0 -- 2020-01-04
* First version. Split from 'hpath', contains only the IO parts.
* Now uses streamly for 'copyFile'
* Fixed tmpdir in hspec

View File

@ -1,30 +0,0 @@
Copyright (c) 2020, Julian Ospald
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Julian Ospald nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View File

@ -1,27 +0,0 @@
# HPath-IO
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-io.svg)](http://packdeps.haskellers.com/feed?needle=hpath-io)
High-level IO operations on files/directories, utilizing type-safe Paths. This uses [hpath-directory](https://hackage.haskell.org/package/hpath-directory) under the hood.
This package is part of the HPath suite, also check out:
* [hpath](https://hackage.haskell.org/package/hpath)
* [hpath-directory](https://hackage.haskell.org/package/hpath-directory)
* [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath)
## Motivation
The motivation came during development of
[hsfm](https://github.com/hasufell/hsfm)
in order to have a proper high-level API of file related operations,
while utilizing type-safe Paths.
## Goals
* high-level API to file operations like recursive directory copy
* still allowing sufficient control to interact with the underlying low-level calls
* unit-testing exceptions (because yes, people may rely on them)
Note: this library was written for __posix__ systems and it will probably not support other systems.

View File

@ -1,2 +0,0 @@
import Distribution.Simple
main = defaultMain

View File

@ -1,6 +0,0 @@
# TODO
## Tests
* `doesExist` not tested
* `readFileStream` only implicitly tested by `readFile`

View File

@ -1,46 +0,0 @@
name: hpath-io
version: 0.13.2
synopsis: High-level IO operations on files/directories
description: High-level IO operations on files/directories, utilizing type-safe Paths
-- bug-reports:
license: BSD3
license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de>
maintainer: Julian Ospald <hasufell@posteo.de>
copyright: Julian Ospald 2016
category: Filesystem
build-type: Simple
cabal-version: 1.14
tested-with: GHC==7.10.3
, GHC==8.0.2
, GHC==8.2.2
, GHC==8.4.4
, GHC==8.6.5
, GHC==8.8.1
extra-source-files: README.md
CHANGELOG.md
library
if os(windows)
build-depends: unbuildable<0
buildable: False
exposed-modules: HPath.IO
build-depends: base >= 4.8 && <5
, bytestring >= 0.10.0.0
, exceptions
, hpath >= 0.11 && < 0.12
, hpath-directory >= 0.13 && < 0.14
, hpath-posix >= 0.13 && < 0.14
, safe-exceptions >= 0.1
, streamly >= 0.7
, time >= 1.8
, unix >= 2.5
if !impl(ghc>=7.11)
build-depends: transformers
hs-source-dirs: src
default-language: Haskell2010
source-repository head
type: git
location: https://github.com/hasufell/hpath

View File

@ -1,865 +0,0 @@
-- |
-- Module : HPath.IO
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- This module provides high-level IO related file operations like
-- copy, delete, move and so on. It only operates on /Path x/ which
-- guarantees us well-typed paths. This is a thin wrapper over
-- System.Posix.RawFilePath.Directory in 'hpath-directory'. It's
-- encouraged to use this module.
--
-- Some of these operations are due to their nature __not atomic__, which
-- means they may do multiple syscalls which form one context. Some
-- of them also have to examine the filetypes explicitly before the
-- syscalls, so a reasonable decision can be made. That means
-- the result is undefined if another process changes that context
-- while the non-atomic operation is still happening. However, where
-- possible, as few syscalls as possible are used and the underlying
-- exception handling is kept.
--
-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`
-- are ignored by some of the more high-level functions (like `easyCopy`).
-- For other functions (like `copyFile`), the behavior on these file types is
-- unreliable/unsafe. Check the documentation of those functions for details.
{-# LANGUAGE FlexibleContexts #-} -- streamly
{-# LANGUAGE PackageImports #-}
module HPath.IO
(
-- * Types
FileType(..)
, RecursiveErrorMode(..)
, CopyMode(..)
-- * File copying
, copyDirRecursive
, recreateSymlink
, copyFile
, easyCopy
-- * File deletion
, deleteFile
, deleteDir
, deleteDirRecursive
, easyDelete
-- * File opening
, openFile
, executeFile
-- * File creation
, createRegularFile
, createDir
, createDirIfMissing
, createDirRecursive
, createSymlink
-- * File renaming/moving
, renameFile
, moveFile
-- * File reading
, readFile
, readFileStream
-- * File writing
, writeFile
, writeFileL
, appendFile
-- * File permissions
, RD.newFilePerms
, RD.newDirPerms
-- * File checks
, doesExist
, doesFileExist
, doesDirectoryExist
, isReadable
, isWritable
, isExecutable
, canOpenDirectory
-- * File times
, getModificationTime
, setModificationTime
, setModificationTimeHiRes
-- * Directory reading
, getDirsFiles
, getDirsFiles'
, getDirsFilesStream
-- * Filetype operations
, getFileType
-- * Others
, canonicalizePath
, toAbs
, withRawFilePath
, withHandle
, module System.Posix.RawFilePath.Directory.Errors
)
where
import Control.Exception.Safe ( MonadMask
, MonadCatch
, bracketOnError
, finally
)
import Control.Monad.Catch ( MonadThrow(..) )
import Data.ByteString ( ByteString )
import Data.Traversable ( for )
import qualified Data.ByteString.Lazy as L
import Data.Time.Clock
import Data.Time.Clock.POSIX ( POSIXTime )
import HPath
import Prelude hiding ( appendFile
, readFile
, writeFile
)
import Streamly
import qualified System.IO as SIO
import System.Posix.Directory.ByteString
( getWorkingDirectory )
import qualified "unix" System.Posix.IO.ByteString
as SPI
import System.Posix.FD ( openFd )
import System.Posix.RawFilePath.Directory.Errors
import System.Posix.Types ( FileMode
, ProcessID
, EpochTime
)
import qualified System.Posix.RawFilePath.Directory
as RD
import System.Posix.RawFilePath.Directory
( FileType
, RecursiveErrorMode
, CopyMode
)
--------------------
--[ File Copying ]--
--------------------
-- |Copies the contents of a directory recursively to the given destination, while preserving permissions.
-- Does not follow symbolic links. This behaves more or less like
-- the following, without descending into the destination if it
-- already exists:
--
-- @
-- cp -a \/source\/dir \/destination\/somedir
-- @
--
-- For directory contents, this will ignore any file type that is not
-- `RegularFile`, `SymbolicLink` or `Directory`.
--
-- For `Overwrite` copy mode this does not prune destination directory
-- contents, so the destination might contain more files than the source after
-- the operation has completed. Permissions of existing directories are
-- fixed.
--
-- Safety/reliability concerns:
--
-- * not atomic
-- * examines filetypes explicitly
-- * an explicit check `throwDestinationInSource` is carried out for the
-- top directory for basic sanity, because otherwise we might end up
-- with an infinite copy loop... however, this operation is not
-- carried out recursively (because it's slow)
--
-- Throws:
--
-- - `NoSuchThing` if source directory does not exist
-- - `PermissionDenied` if source directory can't be opened
-- - `SameFile` if source and destination are the same file
-- (`HPathIOException`)
-- - `DestinationInSource` if destination is contained in source
-- (`HPathIOException`)
--
-- Throws in `FailEarly` RecursiveErrorMode only:
--
-- - `PermissionDenied` if output directory is not writable
-- - `InvalidArgument` if source directory is wrong type (symlink)
-- - `InappropriateType` if source directory is wrong type (regular file)
--
-- Throws in `CollectFailures` RecursiveErrorMode only:
--
-- - `RecursiveFailure` if any of the recursive operations that are not
-- part of the top-directory sanity-checks fail (`HPathIOException`)
--
-- Throws in `Strict` CopyMode only:
--
-- - `AlreadyExists` if destination already exists
--
-- Note: may call `getcwd` (only if destination is a relative path)
copyDirRecursive :: Path b1 -- ^ source dir
-> Path b2 -- ^ destination (parent dirs
-- are not automatically created)
-> CopyMode
-> RecursiveErrorMode
-> IO ()
copyDirRecursive (Path fromp) (Path destdirp) cm rm =
RD.copyDirRecursive fromp destdirp cm rm
-- |Recreate a symlink.
--
-- In `Overwrite` copy mode only files and empty directories are deleted.
--
-- Safety/reliability concerns:
--
-- * `Overwrite` mode is inherently non-atomic
--
-- Throws:
--
-- - `InvalidArgument` if source file is wrong type (not a symlink)
-- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened
-- - `SameFile` if source and destination are the same file
-- (`HPathIOException`)
--
--
-- Throws in `Strict` mode only:
--
-- - `AlreadyExists` if destination already exists
--
-- Throws in `Overwrite` mode only:
--
-- - `UnsatisfiedConstraints` if destination file is non-empty directory
--
-- Notes:
--
-- - calls `symlink`
-- - calls `getcwd` in Overwrite mode (if destination is a relative path)
recreateSymlink :: Path b1 -- ^ the old symlink file
-> Path b2 -- ^ destination file
-> CopyMode
-> IO ()
recreateSymlink (Path symsourceBS) (Path newsymBS) cm =
RD.recreateSymlink symsourceBS newsymBS cm
-- |Copies the given regular file to the given destination.
-- Neither follows symbolic links, nor accepts them.
-- For "copying" symbolic links, use `recreateSymlink` instead.
--
-- Note that this is still sort of a low-level function and doesn't
-- examine file types. For a more high-level version, use `easyCopy`
-- instead.
--
-- In `Overwrite` copy mode only overwrites actual files, not directories.
-- In `Strict` mode the destination file must not exist.
--
-- Safety/reliability concerns:
--
-- * `Overwrite` mode is not atomic
-- * when used on `CharacterDevice`, reads the "contents" and copies
-- them to a regular file, which might take indefinitely
-- * when used on `BlockDevice`, may either read the "contents"
-- and copy them to a regular file (potentially hanging indefinitely)
-- or may create a regular empty destination file
-- * when used on `NamedPipe`, will hang indefinitely
--
-- Throws:
--
-- - `NoSuchThing` if source file does not exist
-- - `NoSuchThing` if source file is a a `Socket`
-- - `PermissionDenied` if output directory is not writable
-- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source file is wrong type (symlink or directory)
-- - `SameFile` if source and destination are the same file
-- (`HPathIOException`)
--
-- Throws in `Strict` mode only:
--
-- - `AlreadyExists` if destination already exists
--
-- Notes:
--
-- - may call `getcwd` in Overwrite mode (if destination is a relative path)
copyFile :: Path b1 -- ^ source file
-> Path b2 -- ^ destination file
-> CopyMode
-> IO ()
copyFile (Path from) (Path to) cm = RD.copyFile from to cm
-- |Copies a regular file, directory or symbolic link. In case of a
-- symbolic link it is just recreated, even if it points to a directory.
-- Any other file type is ignored.
--
-- Safety/reliability concerns:
--
-- * examines filetypes explicitly
-- * calls `copyDirRecursive` for directories
--
-- Note: may call `getcwd` in Overwrite mode (if destination is a relative path)
easyCopy :: Path b1 -> Path b2 -> CopyMode -> RecursiveErrorMode -> IO ()
easyCopy (Path from) (Path to) cm rm = RD.easyCopy from to cm rm
---------------------
--[ File Deletion ]--
---------------------
-- |Deletes the given file. Raises `eISDIR`
-- if run on a directory. Does not follow symbolic links.
--
-- Throws:
--
-- - `InappropriateType` for wrong file type (directory)
-- - `NoSuchThing` if the file does not exist
-- - `PermissionDenied` if the directory cannot be read
deleteFile :: Path b -> IO ()
deleteFile (Path p) = RD.deleteFile p
-- |Deletes the given directory, which must be empty, never symlinks.
--
-- Throws:
--
-- - `InappropriateType` for wrong file type (symlink to directory)
-- - `InappropriateType` for wrong file type (regular file)
-- - `NoSuchThing` if directory does not exist
-- - `UnsatisfiedConstraints` if directory is not empty
-- - `PermissionDenied` if we can't open or write to parent directory
--
-- Notes: calls `rmdir`
deleteDir :: Path b -> IO ()
deleteDir (Path p) = RD.deleteDir p
-- |Deletes the given directory recursively. Does not follow symbolic
-- links. Tries `deleteDir` first before attemtping a recursive
-- deletion.
--
-- On directory contents this behaves like `easyDelete`
-- and thus will ignore any file type that is not `RegularFile`,
-- `SymbolicLink` or `Directory`.
--
-- Safety/reliability concerns:
--
-- * not atomic
-- * examines filetypes explicitly
--
-- Throws:
--
-- - `InappropriateType` for wrong file type (symlink to directory)
-- - `InappropriateType` for wrong file type (regular file)
-- - `NoSuchThing` if directory does not exist
-- - `PermissionDenied` if we can't open or write to parent directory
deleteDirRecursive :: Path b -> IO ()
deleteDirRecursive (Path p) = RD.deleteDirRecursive p
-- |Deletes a file, directory or symlink.
-- In case of directory, performs recursive deletion. In case of
-- a symlink, the symlink file is deleted.
-- Any other file type is ignored.
--
-- Safety/reliability concerns:
--
-- * examines filetypes explicitly
-- * calls `deleteDirRecursive` for directories
easyDelete :: Path b -> IO ()
easyDelete (Path p) = RD.easyDelete p
--------------------
--[ File Opening ]--
--------------------
-- |Opens a file appropriately by invoking xdg-open. The file type
-- is not checked. This forks a process.
openFile :: Path b -> IO ProcessID
openFile (Path fp) = RD.openFile fp
-- |Executes a program with the given arguments. This forks a process.
executeFile :: Path b -- ^ program
-> [ByteString] -- ^ arguments
-> IO ProcessID
executeFile (Path fp) args = RD.executeFile fp args
---------------------
--[ File Creation ]--
---------------------
-- |Create an empty regular file at the given directory with the given
-- filename.
--
-- Throws:
--
-- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination already exists
-- - `NoSuchThing` if any of the parent components of the path
-- do not exist
createRegularFile :: FileMode -> Path b -> IO ()
createRegularFile fm (Path destBS) = RD.createRegularFile fm destBS
-- |Create an empty directory at the given directory with the given filename.
--
-- Throws:
--
-- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination already exists
-- - `NoSuchThing` if any of the parent components of the path
-- do not exist
createDir :: FileMode -> Path b -> IO ()
createDir fm (Path destBS) = RD.createDir fm destBS
-- |Create an empty directory at the given directory with the given filename.
--
-- Throws:
--
-- - `PermissionDenied` if output directory cannot be written to
-- - `NoSuchThing` if any of the parent components of the path
-- do not exist
createDirIfMissing :: FileMode -> Path b -> IO ()
createDirIfMissing fm (Path destBS) = RD.createDirIfMissing fm destBS
-- |Create an empty directory at the given directory with the given filename.
-- All parent directories are created with the same filemode. This
-- basically behaves like:
--
-- @
-- mkdir -p \/some\/dir
-- @
--
-- Safety/reliability concerns:
--
-- * not atomic
--
-- Throws:
--
-- - `PermissionDenied` if any part of the path components do not
-- exist and cannot be written to
-- - `AlreadyExists` if destination already exists and
-- is *not* a directory
--
-- Note: calls `getcwd` if the input path is a relative path
createDirRecursive :: FileMode -> Path b -> IO ()
createDirRecursive fm (Path p) = RD.createDirRecursive fm p
-- |Create a symlink.
--
-- Throws:
--
-- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination file already exists
-- - `NoSuchThing` if any of the parent components of the path
-- do not exist
--
-- Note: calls `symlink`
createSymlink :: Path b -- ^ destination file
-> ByteString -- ^ path the symlink points to
-> IO ()
createSymlink (Path destBS) sympoint = RD.createSymlink destBS sympoint
----------------------------
--[ File Renaming/Moving ]--
----------------------------
-- |Rename a given file with the provided filename. Destination and source
-- must be on the same device, otherwise `eXDEV` will be raised.
--
-- Does not follow symbolic links, but renames the symbolic link file.
--
-- Safety/reliability concerns:
--
-- * has a separate set of exception handling, apart from the syscall
--
-- Throws:
--
-- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened
-- - `UnsupportedOperation` if source and destination are on different
-- devices
-- - `AlreadyExists` if destination already exists
-- - `SameFile` if destination and source are the same file
-- (`HPathIOException`)
--
-- Note: calls `rename` (but does not allow to rename over existing files)
renameFile :: Path b1 -> Path b2 -> IO ()
renameFile (Path from) (Path to) = RD.renameFile from to
-- |Move a file. This also works across devices by copy-delete fallback.
-- And also works on directories.
--
-- Does not follow symbolic links, but renames the symbolic link file.
--
--
-- Safety/reliability concerns:
--
-- * `Overwrite` mode is not atomic
-- * copy-delete fallback is inherently non-atomic
-- * since this function calls `easyCopy` and `easyDelete` as a fallback
-- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink`
-- or `Directory` may be ignored
-- * for `Overwrite` mode, the destination will be deleted (not recursively)
-- before moving
--
-- Throws:
--
-- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened
-- - `SameFile` if destination and source are the same file
-- (`HPathIOException`)
--
-- Throws in `Strict` mode only:
--
-- - `AlreadyExists` if destination already exists
--
-- Notes:
--
-- - calls `rename` (but does not allow to rename over existing files)
-- - calls `getcwd` in Overwrite mode if destination is a relative path
moveFile :: Path b1 -- ^ file to move
-> Path b2 -- ^ destination
-> CopyMode
-> IO ()
moveFile (Path from) (Path to) cm = RD.moveFile from to cm
--------------------
--[ File Reading ]--
--------------------
-- |Read the given file *at once* into memory as a lazy ByteString.
-- Symbolic links are followed, no sanity checks on file size
-- or file type. File must exist. Uses Builders under the hood
-- (hence lazy ByteString).
--
-- Safety/reliability concerns:
--
-- * the whole file is read into memory, this doesn't read lazily
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
readFile :: Path b -> IO L.ByteString
readFile (Path path) = RD.readFile path
-- | Open the given file as a filestream. Once the filestream is
-- exits, the filehandle is cleaned up.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
readFileStream :: Path b -> IO (SerialT IO ByteString)
readFileStream (Path fp) = RD.readFileStream fp
--------------------
--[ File Writing ]--
--------------------
-- |Write a given ByteString to a file, truncating the file beforehand.
-- Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
writeFile :: Path b
-> Maybe FileMode -- ^ if Nothing, file must exist
-> ByteString
-> IO ()
writeFile (Path fp) fmode bs = RD.writeFile fp fmode bs
-- |Write a given lazy ByteString to a file, truncating the file beforehand.
-- Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
--
-- Note: uses streamly under the hood
writeFileL :: Path b
-> Maybe FileMode -- ^ if Nothing, file must exist
-> L.ByteString
-> IO ()
writeFileL (Path fp) fmode lbs = RD.writeFileL fp fmode lbs
-- |Append a given ByteString to a file.
-- The file must exist. Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
appendFile :: Path b -> ByteString -> IO ()
appendFile (Path fp) bs = RD.appendFile fp bs
-------------------
--[ File checks ]--
-------------------
-- |Checks if the given file exists.
-- Does not follow symlinks.
--
-- Only eNOENT is catched (and returns False).
doesExist :: Path b -> IO Bool
doesExist (Path bs) = RD.doesExist bs
-- |Checks if the given file exists and is not a directory.
-- Does not follow symlinks.
--
-- Only eNOENT is catched (and returns False).
doesFileExist :: Path b -> IO Bool
doesFileExist (Path bs) = RD.doesFileExist bs
-- |Checks if the given file exists and is a directory.
-- Does not follow symlinks.
--
-- Only eNOENT is catched (and returns False).
doesDirectoryExist :: Path b -> IO Bool
doesDirectoryExist (Path bs) = RD.doesDirectoryExist bs
-- |Checks whether a file or folder is readable.
--
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
--
-- Throws:
--
-- - `NoSuchThing` if the file does not exist
isReadable :: Path b -> IO Bool
isReadable (Path bs) = RD.isReadable bs
-- |Checks whether a file or folder is writable.
--
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
--
-- Throws:
--
-- - `NoSuchThing` if the file does not exist
isWritable :: Path b -> IO Bool
isWritable (Path bs) = RD.isWritable bs
-- |Checks whether a file or folder is executable.
--
-- Only eACCES, eROFS, eTXTBSY, ePERM are catched (and return False).
--
-- Throws:
--
-- - `NoSuchThing` if the file does not exist
isExecutable :: Path b -> IO Bool
isExecutable (Path bs) = RD.isExecutable bs
-- |Checks whether the directory at the given path exists and can be
-- opened. This invokes `openDirStream` which follows symlinks.
canOpenDirectory :: Path b -> IO Bool
canOpenDirectory (Path bs) = RD.canOpenDirectory bs
------------------
--[ File times ]--
------------------
getModificationTime :: Path b -> IO UTCTime
getModificationTime (Path bs) = RD.getModificationTime bs
setModificationTime :: Path b -> EpochTime -> IO ()
setModificationTime (Path bs) t = RD.setModificationTime bs t
setModificationTimeHiRes :: Path b -> POSIXTime -> IO ()
setModificationTimeHiRes (Path bs) t = RD.setModificationTimeHiRes bs t
-------------------------
--[ Directory reading ]--
-------------------------
-- |Gets all filenames of the given directory. This excludes "." and "..".
-- This version does not follow symbolic links.
--
-- The contents are not sorted and there is no guarantee on the ordering.
--
-- Throws:
--
-- - `NoSuchThing` if directory does not exist
-- - `InappropriateType` if file type is wrong (file)
-- - `InappropriateType` if file type is wrong (symlink to file)
-- - `InappropriateType` if file type is wrong (symlink to dir)
-- - `PermissionDenied` if directory cannot be opened
-- - `PathParseException` if a filename could not be parsed (should never happen)
getDirsFiles :: Path b -- ^ dir to read
-> IO [Path b]
getDirsFiles p = do
contents <- getDirsFiles' p
pure $ fmap (p </>) contents
-- | Like 'getDirsFiles', but returns the filename only, instead
-- of prepending the base path.
getDirsFiles' :: Path b -- ^ dir to read
-> IO [Path Rel]
getDirsFiles' (Path fp) = do
rawContents <- RD.getDirsFiles' fp
for rawContents $ \r -> parseRel r
-- | Like 'getDirsFiles'', except returning a Stream.
getDirsFilesStream :: (MonadCatch m, MonadAsync m, MonadMask m)
=> Path b
-> IO (SerialT m (Path Rel))
getDirsFilesStream (Path fp) = do
s <- RD.getDirsFilesStream fp
pure (s >>= parseRel)
---------------------------
--[ FileType operations ]--
---------------------------
-- |Get the file type of the file located at the given path. Does
-- not follow symbolic links.
--
-- Throws:
--
-- - `NoSuchThing` if the file does not exist
-- - `PermissionDenied` if any part of the path is not accessible
getFileType :: Path b -> IO FileType
getFileType (Path fp) = RD.getFileType fp
--------------
--[ Others ]--
--------------
-- |Applies `realpath` on the given path.
--
-- Throws:
--
-- - `NoSuchThing` if the file at the given path does not exist
-- - `NoSuchThing` if the symlink is broken
-- - `PathParseException` if realpath does not return an absolute path
canonicalizePath :: Path b -> IO (Path Abs)
canonicalizePath (Path l) = do
nl <- RD.canonicalizePath l
parseAbs nl
-- |Converts any path to an absolute path.
-- This is done in the following way:
--
-- - if the path is already an absolute one, just return it
-- - if it's a relative path, prepend the current directory to it
toAbs :: Path b -> IO (Path Abs)
toAbs (Path bs) = do
let mabs = parseAbs bs :: Maybe (Path Abs)
case mabs of
Just a -> return a
Nothing -> do
cwd <- getWorkingDirectory >>= parseAbs
r <- parseRel bs -- we know it must be relative now
return $ cwd </> r
-- | Helper function to use the Path library without
-- buying into the Path type too much. This uses 'parseAny'
-- under the hood and may throw `PathParseException`.
--
-- Throws:
--
-- - `PathParseException` if the bytestring could neither be parsed as
-- relative or absolute Path
withRawFilePath :: MonadThrow m
=> ByteString
-> (Either (Path Abs) (Path Rel) -> m b)
-> m b
withRawFilePath bs action = do
path <- parseAny bs
action path
-- | Convenience function to open the path as a handle.
--
-- If the file does not exist, it will be created with 'newFilePerms'.
--
-- Throws:
--
-- - `PathParseException` if the bytestring could neither be parsed as
-- relative or absolute Path
withHandle :: ByteString
-> SPI.OpenMode
-> ((SIO.Handle, Either (Path Abs) (Path Rel)) -> IO a)
-> IO a
withHandle bs mode action = do
path <- parseAny bs
handle <-
bracketOnError (openFd bs mode [] (Just RD.newFilePerms)) (SPI.closeFd)
$ SPI.fdToHandle
finally (action (handle, path)) (SIO.hClose handle)

View File

@ -1,14 +0,0 @@
# Revision history for hpath-posix
## 0.13.2 -- 2020-04-14
* fix macOS compatibility, especially with memory bug in `fdopendir`
## 0.13.1 -- 2020-02-08
* Remove unnecessary dependencies
## 0.13.0 -- 2020-01-29
* First version. Released on an unsuspecting world.

View File

@ -1,30 +0,0 @@
Copyright (c) 2020, Julian Ospald
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* Neither the name of Julian Ospald nor the names of other
contributors may be used to endorse or promote products derived
from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

View File

@ -1,13 +0,0 @@
# HPath-filepath
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-posix.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-posix) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-posix.svg)](http://packdeps.haskellers.com/feed?needle=hpath-posix)
Some low-level POSIX glue code, that is not in 'unix'.
This package is part of the HPath suite, also check out:
* [hpath](https://hackage.haskell.org/package/hpath)
* [hpath-directory](https://hackage.haskell.org/package/hpath-directory)
* [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath)
* [hpath-io](https://hackage.haskell.org/package/hpath-io)

View File

@ -1,2 +0,0 @@
import Distribution.Simple
main = defaultMain

View File

@ -1,7 +0,0 @@
#include "dirutils.h"
unsigned int
__posixdir_d_type(struct dirent* d)
{
return(d -> d_type);
}

View File

@ -1,15 +0,0 @@
#ifndef POSIXPATHS_CBITS_DIRUTILS_H
#define POSIXPATHS_CBITS_DIRUTILS_H
#include <stdlib.h>
#include <dirent.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
extern unsigned int
__posixdir_d_type(struct dirent* d)
;
#endif

View File

@ -1,48 +0,0 @@
cabal-version: >=1.10
name: hpath-posix
version: 0.13.2
synopsis: Some low-level POSIX glue code, that is not in 'unix'
homepage: https://github.com/hasufell/hpath
bug-reports: https://github.com/hasufell/hpath/issues
license: BSD3
license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de>
maintainer: Julian Ospald <hasufell@posteo.de>
copyright: Julian Ospald <hasufell@posteo.de> 2020
category: Filesystem
build-type: Simple
extra-source-files: CHANGELOG.md
cbits/dirutils.h
tested-with: GHC==7.10.3
, GHC==8.0.2
, GHC==8.2.2
, GHC==8.4.4
, GHC==8.6.5
, GHC==8.8.1
library
if os(windows)
build-depends: unbuildable<0
buildable: False
exposed-modules: System.Posix.RawFilePath.Directory.Traversals
System.Posix.Foreign
System.Posix.FD
-- other-modules:
-- other-extensions:
c-sources: cbits/dirutils.c
build-depends: base >= 4.8 && <5
, bytestring >= 0.10
, hpath-filepath >= 0.10.3
, unix >= 2.5
if impl(ghc < 8.0)
build-depends:
fail >= 4.9
hs-source-dirs: src
default-language: Haskell2010
default-extensions: PackageImports
source-repository head
type: git
location: https://github.com/hasufell/hpath

View File

@ -1,75 +0,0 @@
-- |
-- Module : System.Posix.FD
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Provides an alternative for `System.Posix.IO.ByteString.openFd`
-- which gives us more control on what status flags to pass to the
-- low-level @open(2)@ call, in contrast to the unix package.
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}
module System.Posix.FD (
openFd
) where
import Foreign.C.String
import Foreign.C.Types
import System.Posix.Foreign
import qualified System.Posix as Posix
import System.Posix.ByteString.FilePath
foreign import ccall unsafe "open"
c_open :: CString -> CInt -> Posix.CMode -> IO CInt
open_ :: CString
-> Posix.OpenMode
-> [Flags]
-> Maybe Posix.FileMode
-> IO Posix.Fd
open_ str how optional_flags maybe_mode = do
fd <- c_open str all_flags mode_w
return (Posix.Fd fd)
where
all_flags = unionFlags $ optional_flags ++ [open_mode] ++ creat
(creat, mode_w) = case maybe_mode of
Nothing -> ([],0)
Just x -> ([oCreat], x)
open_mode = case how of
Posix.ReadOnly -> oRdonly
Posix.WriteOnly -> oWronly
Posix.ReadWrite -> oRdwr
-- |Open and optionally create this file. See 'System.Posix.Files'
-- for information on how to use the 'FileMode' type.
--
-- Note that passing @Just x@ as the 4th argument triggers the
-- `oCreat` status flag, which must be set when you pass in `oExcl`
-- to the status flags. Also see the manpage for @open(2)@.
openFd :: RawFilePath
-> Posix.OpenMode
-> [Flags] -- ^ status flags of @open(2)@
-> Maybe Posix.FileMode -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist.
-> IO Posix.Fd
openFd name how optional_flags maybe_mode =
withFilePath name $ \str ->
throwErrnoPathIfMinus1Retry "openFd" name $
open_ str how optional_flags maybe_mode

View File

@ -1,55 +0,0 @@
module System.Posix.Foreign where
import Data.Bits
import Data.List (foldl')
import Foreign.C.Types
#include <limits.h>
#include <stdlib.h>
#include <dirent.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
newtype DirType = DirType Int deriving (Eq, Show)
data Flags = Flags Int | UnsupportedFlag String deriving (Eq, Show)
unFlags :: Flags -> Int
unFlags (Flags i) = i
unFlags (UnsupportedFlag name) = error (name ++ " is not supported on this platform")
-- |Returns @True@ if posix-paths was compiled with support for the provided
-- flag. (As of this writing, the only flag for which this check may be
-- necessary is 'oCloexec'; all other flags will always yield @True@.)
isSupported :: Flags -> Bool
isSupported (Flags _) = True
isSupported _ = False
-- |@O_CLOEXEC@ is not supported on every POSIX platform. Use
-- @'isSupported' oCloexec@ to determine if support for @O_CLOEXEC@ was
-- compiled into your version of posix-paths. (If not, using @oCloexec@ will
-- throw an exception.)
oCloexec :: Flags
#ifdef O_CLOEXEC
oCloexec = Flags #{const O_CLOEXEC}
#else
{-# WARNING oCloexec
"This version of posix-paths was compiled without @O_CLOEXEC@ support." #-}
oCloexec = UnsupportedFlag "O_CLOEXEC"
#endif
-- If these enum declarations occur earlier in the file, haddock
-- gets royally confused about the above doc comments.
-- Probably http://trac.haskell.org/haddock/ticket/138
#{enum DirType, DirType, DT_BLK, DT_CHR, DT_DIR, DT_FIFO, DT_LNK, DT_REG, DT_SOCK, DT_UNKNOWN}
#{enum Flags, Flags, O_APPEND, O_ASYNC, O_CREAT, O_DIRECTORY, O_EXCL, O_NOCTTY, O_NOFOLLOW, O_NONBLOCK, O_RDONLY, O_WRONLY, O_RDWR, O_SYNC, O_TRUNC}
pathMax :: Int
pathMax = #{const PATH_MAX}
unionFlags :: [Flags] -> CInt
unionFlags = fromIntegral . foldl' ((. unFlags) . (.|.)) 0

View File

@ -1,268 +0,0 @@
-- |
-- Module : System.Posix.RawFilePath.Directory.Traversals
-- Copyright : © 2016 Julian Ospald
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Traversal and read operations on directories.
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
module System.Posix.RawFilePath.Directory.Traversals (
getDirectoryContents
, getDirectoryContents'
, allDirectoryContents
, allDirectoryContents'
, traverseDirectory
-- lower-level stuff
, readDirEnt
, packDirStream
, unpackDirStream
, fdOpendir
, realpath
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad
import System.Posix.FilePath ((</>))
import System.Posix.Foreign
import qualified System.Posix as Posix
import System.IO.Error
import Control.Exception
import qualified Data.ByteString.Char8 as BS
import System.Posix.ByteString.FilePath
import System.Posix.Directory.ByteString as PosixBS
import System.Posix.Files.ByteString
import System.IO.Unsafe
import "unix" System.Posix.IO.ByteString (closeFd)
import Unsafe.Coerce (unsafeCoerce)
import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca,allocaBytes)
import Foreign.Ptr
import Foreign.Storable
----------------------------------------------------------
-- | Get all files from a directory and its subdirectories.
--
-- Upon entering a directory, 'allDirectoryContents' will get all entries
-- strictly. However the returned list is lazy in that directories will only
-- be accessed on demand.
--
-- Follows symbolic links for the input dir.
allDirectoryContents :: RawFilePath -> IO [RawFilePath]
allDirectoryContents topdir = do
namesAndTypes <- getDirectoryContents topdir
let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes
paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do
let path = topdir </> name
case () of
() | typ == dtDir -> allDirectoryContents path
| typ == dtUnknown -> do
isDir <- isDirectory <$> getFileStatus path
if isDir
then allDirectoryContents path
else return [path]
| otherwise -> return [path]
return (topdir : concat paths)
-- | Get all files from a directory and its subdirectories strictly.
--
-- Follows symbolic links for the input dir.
allDirectoryContents' :: RawFilePath -> IO [RawFilePath]
allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) []
-- this uses traverseDirectory because it's more efficient than forcing the
-- lazy version.
-- | Recursively apply the 'action' to the parent directory and all
-- files/subdirectories.
--
-- This function allows for memory-efficient traversals.
--
-- Follows symbolic links for the input dir.
traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s
traverseDirectory act s0 topdir = toploop
where
toploop = do
isDir <- isDirectory <$> getFileStatus topdir
s' <- act s0 topdir
if isDir then actOnDirContents topdir s' loop
else return s'
loop typ path acc = do
isDir <- case () of
() | typ == dtDir -> return True
| typ == dtUnknown -> isDirectory <$> getFileStatus path
| otherwise -> return False
if isDir
then act acc path >>= \acc' -> actOnDirContents path acc' loop
else act acc path
actOnDirContents :: RawFilePath
-> b
-> (DirType -> RawFilePath -> b -> IO b)
-> IO b
actOnDirContents pathRelToTop b f =
modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .
(`ioeSetLocation` "findBSTypRel")) $
bracket
(openDirStream pathRelToTop)
Posix.closeDirStream
(\dirp -> loop dirp b)
where
loop dirp b' = do
(typ,e) <- readDirEnt dirp
if (e == "")
then return b'
else
if (e == "." || e == "..")
then loop dirp b'
else f typ (pathRelToTop </> e) b' >>= loop dirp
----------------------------------------------------------
-- dodgy stuff
type CDir = ()
type CDirent = ()
-- Posix doesn't export DirStream, so to re-use that type we need to use
-- unsafeCoerce. It's just a newtype, so this is a legitimate usage.
-- ugly trick.
unpackDirStream :: DirStream -> Ptr CDir
unpackDirStream = unsafeCoerce
packDirStream :: Ptr CDir -> DirStream
packDirStream = unsafeCoerce
-- the __hscore_* functions are defined in the unix package. We can import them and let
-- the linker figure it out.
foreign import ccall unsafe "__hscore_readdir"
c_readdir :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt
foreign import ccall unsafe "__hscore_free_dirent"
c_freeDirEnt :: Ptr CDirent -> IO ()
foreign import ccall unsafe "__hscore_d_name"
c_name :: Ptr CDirent -> IO CString
foreign import ccall unsafe "__posixdir_d_type"
c_type :: Ptr CDirent -> IO DirType
foreign import capi "stdlib.h realpath"
c_realpath :: CString -> CString -> IO CString
-- Using normal 'ccall' here lead to memory bugs, crashes
-- and corrupted d_name entries. It appears there are two fdopendirs:
-- https://opensource.apple.com/source/Libc/Libc-1244.1.7/include/dirent.h.auto.html
-- The capi call picks the correct one.
foreign import capi unsafe "dirent.h fdopendir"
c_fdopendir :: Posix.Fd -> IO (Ptr CDir)
----------------------------------------------------------
-- less dodgy but still lower-level
readDirEnt :: DirStream -> IO (DirType, RawFilePath)
readDirEnt (unpackDirStream -> dirp) =
alloca $ \ptr_dEnt -> loop ptr_dEnt
where
loop ptr_dEnt = do
resetErrno
r <- c_readdir dirp ptr_dEnt
if (r == 0)
then do
dEnt <- peek ptr_dEnt
if (dEnt == nullPtr)
then return (dtUnknown,BS.empty)
else do
dName <- c_name dEnt >>= peekFilePath
dType <- c_type dEnt
c_freeDirEnt dEnt
return (dType, dName)
else do
errno <- getErrno
if (errno == eINTR)
then loop ptr_dEnt
else do
let (Errno eo) = errno
if (eo == 0)
then return (dtUnknown,BS.empty)
else throwErrno "readDirEnt"
-- |Gets all directory contents (not recursively).
getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]
getDirectoryContents path =
modifyIOError ((`ioeSetFileName` (BS.unpack path)) .
(`ioeSetLocation` "System.Posix.RawFilePath.Directory.Traversals.getDirectoryContents")) $
bracket
(PosixBS.openDirStream path)
PosixBS.closeDirStream
_dirloop
-- |Binding to @fdopendir(3)@.
fdOpendir :: Posix.Fd -> IO DirStream
fdOpendir fd =
packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)
-- |Like `getDirectoryContents` except for a file descriptor.
--
-- To avoid complicated error checks, the file descriptor is
-- __always__ closed, even if `fdOpendir` fails. Usually, this
-- only happens on successful `fdOpendir` and after the directory
-- stream is closed. Also see the manpage of @fdopendir(3)@ for
-- more details.
getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)]
getDirectoryContents' fd = do
dirstream <- fdOpendir fd `catchIOError` \e -> do
closeFd fd
ioError e
-- closeDirStream closes the filedescriptor
finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream)
_dirloop :: DirStream -> IO [(DirType, RawFilePath)]
{-# INLINE _dirloop #-}
_dirloop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- _dirloop dirp
return (t:es)
-- | return the canonicalized absolute pathname
--
-- like canonicalizePath, but uses @realpath(3)@
realpath :: RawFilePath -> IO RawFilePath
realpath inp =
allocaBytes pathMax $ \tmp -> do
void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp
BS.packCString tmp

View File

@ -1,89 +0,0 @@
0.11.0
* Many API breaking changes
* Remove RelC and Fn, because they complicate API/break semantics (see #29)
* Redo 'parseAny'
* Unexpose HPath.Internal
* Don't preserve trailing path separators (if you need to pass something to a C function that way, do it manually)
* Added `rooPath`, `isRootPath`, `getAllComponents`, `getAllComponentsAfterRoot`
0.10.2
* Add `parseAny` and the related QuasiQuoter
0.10.1
* Add quasi quoters for hpath
0.10.0
* split packages, this one now just contains the type-safe Path wrappers
0.9.2
* fix build with ghc-7.6
* raise required bytestring version
* Tighten base bound to prevent building before GHC 7.6 (by George Wilson)
0.9.1
* fix build with ghc-7.8 and 7.10
0.9.0
* don't force "Path Abs" anymore in IO module, abstract more over Path types
* add 'toAbs'
0.8.1
* add 'readFile', 'readFileEOF', 'writeFile' and 'appendFile'
0.8.0
* 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument
* introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior)
* 'createRegularFile' and 'createDir' now take FileMode as a parameter (also see 'newFilePerms' and 'newDirPerms')
* various documentation fixes
* improved reliability of tests
0.7.5:
* relicense to BSD3
0.7.3:
* don't expose HPath.Internal
0.7.2:
* fix tests, so they work with the sdist tarball too
* added the following function to HPath.IO: createSymlink
0.7.1:
* various cleanups and documentation improvements
* added the following functions to System.Posix.FilePath: splitSearchPath, getSearchPath, stripExtension, makeRelative, makeValid
0.7.0:
* use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only
* add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath
* add our own openFd version for more control
* small documentation improvements
* add a getDirectoryContents' version that works on Fd
* lift version constraints in benchmark
* remove fpToString and userStringToFP, use Data.ByteString.UTF8 directly instead
0.6.0:
* fixes 'throwDestinationInSource' to be more reliable.
* removes some unused HPathIOException constructors
* consistently provide exception constructor identifiers
* be less harsh when non-supported file types get passed to our functions, possibly ignoring them
* minor cleanups
0.5.9:
* Adds our posix-paths fork and a lot of IO operations.
0.5.8:
* First version of the fork.
0.5.7:
* Fix haddock problem.
0.5.6:
* Reject only .. and .
0.5.5:
* Use filepath's isValid function for additional sanity checks
0.5.4:
* Disable parsing of path consisting only of "."
* Add NFData instance for Path
* Some typo/docs improvements
* Add standard headers to modules
0.5.3:
* Added conversion functions.
0.2.0:
* Rename parentAbs to simply parent.
* Add dirname.
0.3.0:
* Removed Generic instance.
0.4.0:
* Implemented stricter parsing, disabling use of "..".
* Made stripDir generic over MonadThrow
0.5.0:
* Fix stripDir p p /= Nothing bug.
0.5.2:
* Removed unused DeriveGeneric.

View File

@ -1,30 +0,0 @@
Copyright (c) Julian Ospald
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the name of the author nor the names of his contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

View File

@ -1,40 +0,0 @@
# HPath
[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath.svg?label=Hackage)](https://hackage.haskell.org/package/hpath) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath.svg)](http://packdeps.haskellers.com/feed?needle=hpath)
Support for well-typed paths in Haskell.
This package is part of the HPath suite, also check out:
* [hpath-directory](https://hackage.haskell.org/package/hpath-directory)
* [hpath-filepath](https://hackage.haskell.org/package/hpath-filepath)
* [hpath-io](https://hackage.haskell.org/package/hpath-io)
## Motivation
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.
## Goals
* well-typed paths
* safe filepath manipulation, never using String as filepath, but ByteString
Note: this library was written for __posix__ systems and it will probably not support other systems.
## Differences to 'path'
* doesn't attempt to fake IO-related information into the path, so whether a path points to a file or directory is up to your IO-code to decide...
* uses safe ByteString for filepaths under the hood instead of unsafe String
* fixes broken [dirname](https://github.com/chrisdone/path/issues/18)
* renames dirname/filename to basename/dirname to match the POSIX shell functions
* allows pattern matching via unidirectional PatternSynonym
* uses simple doctest for testing
* allows `~/` as relative path, because on posix level `~` is just a regular filename that does _NOT_ point to `$HOME`

View File

@ -1,2 +0,0 @@
import Distribution.Simple
main = defaultMain

View File

@ -1,46 +0,0 @@
name: hpath
version: 0.11.0
synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood.
license: BSD3
license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de>
maintainer: Julian Ospald <hasufell@posteo.de>
copyright: Julian Ospald 2016
category: Filesystem
build-type: Simple
cabal-version: 1.14
tested-with: GHC==7.10.3
, GHC==8.0.2
, GHC==8.2.2
, GHC==8.4.4
, GHC==8.6.5
, GHC==8.8.1
extra-source-files: README.md
CHANGELOG
library
if os(windows)
build-depends: unbuildable<0
buildable: False
hs-source-dirs: src/
default-language: Haskell2010
if impl(ghc >= 8.0)
ghc-options: -Wall -Wno-redundant-constraints
else
ghc-options: -Wall
exposed-modules: HPath
other-modules: HPath.Internal
build-depends: base >= 4.8 && <5
, bytestring >= 0.10.0.0
, deepseq
, exceptions
, hpath-filepath >= 0.10 && < 0.11
, template-haskell
, utf8-string
, word8
source-repository head
type: git
location: https://github.com/hasufell/hpath

View File

@ -1,23 +0,0 @@
#!/bin/sh
set -e
if [ -n "${SKIP_DOCTESTS}" ] ; then
echo "Skipping doctests"
exit 0
fi
if ! command -v doctest >/dev/null ; then
tempdir="$(mktemp -d)"
(
cd "${tempdir}"
cabal install --installdir="${tempdir}" doctest
)
export PATH="${tempdir}:$PATH"
fi
set -x
cd "$(CDPATH= cd -- "$(dirname -- "$0")" && pwd -P)"
cabal exec doctest -- -isrc -XOverloadedStrings -XQuasiQuotes HPath

View File

@ -1,469 +0,0 @@
-- |
-- Module : HPath
-- Copyright : © 20152016 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 CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
#endif
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module HPath
(
-- * Types
Abs
,Path
,Rel
,PathParseException
,PathException
#if __GLASGOW_HASKELL__ >= 708
-- * PatternSynonyms/ViewPatterns
,pattern Path
#endif
-- * Path Construction
,parseAbs
,parseRel
,parseAny
,rootPath
-- * Path Conversion
,fromAbs
,fromRel
,toFilePath
,fromAny
-- * Path Operations
,(</>)
,basename
,dirname
,getAllParents
,getAllComponents
,getAllComponentsAfterRoot
,stripDir
-- * Path Examination
,isParentOf
,isRootPath
-- * Path IO helpers
,withAbsPath
,withRelPath
-- * Quasiquoters
,abs
,rel
)
where
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow(..))
#if MIN_VERSION_bytestring(0,10,8)
import Data.ByteString(ByteString, stripPrefix)
#else
import Data.ByteString(ByteString)
import qualified Data.List as L
#endif
import qualified Data.ByteString as BS
import Data.ByteString.UTF8
import Data.Data
import Data.Maybe
import Data.Word8
import HPath.Internal
import Language.Haskell.TH
import Language.Haskell.TH.Syntax (Exp(..), Lift(..), lift)
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import Prelude hiding (abs, any)
import System.Posix.FilePath hiding ((</>))
--------------------------------------------------------------------------------
-- Types
-- | An absolute path.
data Abs deriving (Typeable)
-- | A relative path; one without a root.
data Rel deriving (Typeable)
-- | Exception when parsing a location.
data PathParseException
= InvalidAbs ByteString
| InvalidRel ByteString
| Couldn'tStripPrefixTPS ByteString ByteString
deriving (Show,Typeable)
instance Exception PathParseException
data PathException = RootDirHasNoBasename
deriving (Show,Typeable)
instance Exception PathException
--------------------------------------------------------------------------------
-- PatternSynonyms
#if __GLASGOW_HASKELL__ >= 710
pattern Path :: ByteString -> Path a
#endif
#if __GLASGOW_HASKELL__ >= 708
pattern Path x <- (MkPath x)
#endif
--------------------------------------------------------------------------------
-- Path Parsers
-- | Get a location for an absolute path. Produces a normalised path.
--
-- Throws: 'PathParseException'
--
-- >>> parseAbs "/abc" :: Maybe (Path Abs)
-- Just "/abc"
-- >>> parseAbs "/" :: Maybe (Path Abs)
-- Just "/"
-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)
-- Just "/abc/def"
-- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs)
-- Just "/abc/def"
-- >>> parseAbs "abc" :: Maybe (Path Abs)
-- Nothing
-- >>> parseAbs "" :: Maybe (Path Abs)
-- Nothing
-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)
-- Nothing
parseAbs :: MonadThrow m
=> ByteString -> m (Path Abs)
parseAbs filepath =
if isAbsolute filepath &&
isValid filepath &&
not (hasParentDir filepath)
then return (MkPath . dropTrailingPathSeparator . normalise $ filepath)
else throwM (InvalidAbs filepath)
-- | Get a location for a relative path. Produces a normalised
-- path.
--
-- Note that @filepath@ may contain any number of @./@ but may not consist
-- solely of @./@. It also may not contain a single @..@ anywhere.
--
-- Throws: 'PathParseException'
--
-- >>> parseRel "abc" :: Maybe (Path Rel)
-- Just "abc"
-- >>> parseRel "def/" :: Maybe (Path Rel)
-- Just "def"
-- >>> parseRel "abc/def" :: Maybe (Path Rel)
-- Just "abc/def"
-- >>> parseRel "abc/def/." :: Maybe (Path Rel)
-- Just "abc/def"
-- >>> parseRel "/abc" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "abc/../foo" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "." :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel ".." :: Maybe (Path Rel)
-- Nothing
parseRel :: MonadThrow m
=> ByteString -> m (Path Rel)
parseRel filepath =
if not (isAbsolute filepath) &&
filepath /= BS.singleton _period &&
filepath /= BS.pack [_period, _period] &&
not (hasParentDir filepath) &&
isValid filepath
then return (MkPath . dropTrailingPathSeparator . normalise $ filepath)
else throwM (InvalidRel filepath)
-- | Parses a path, whether it's relative or absolute.
--
-- Excludes '.' and '..'.
--
-- Throws: 'PathParseException'
--
-- >>> parseAny "/abc" :: Maybe (Either (Path Abs) (Path Rel))
-- Just (Left "/abc")
-- >>> parseAny "..." :: Maybe (Either (Path Abs) (Path Rel))
-- Just (Right "...")
-- >>> parseAny "abc/def" :: Maybe (Either (Path Abs) (Path Rel))
-- Just (Right "abc/def")
-- >>> parseAny "abc/def/." :: Maybe (Either (Path Abs) (Path Rel))
-- Just (Right "abc/def")
-- >>> parseAny "/abc" :: Maybe (Either (Path Abs) (Path Rel))
-- Just (Left "/abc")
-- >>> parseAny "" :: Maybe (Either (Path Abs) (Path Rel))
-- Nothing
-- >>> parseAny "abc/../foo" :: Maybe (Either (Path Abs) (Path Rel))
-- Nothing
-- >>> parseAny "." :: Maybe (Either (Path Abs) (Path Rel))
-- Nothing
-- >>> parseAny ".." :: Maybe (Either (Path Abs) (Path Rel))
-- Nothing
parseAny :: MonadThrow m => ByteString -> m (Either (Path Abs) (Path Rel))
parseAny filepath = case parseAbs filepath of
Just p -> pure $ Left p
Nothing -> case parseRel filepath of
Just p -> pure $ Right p
Nothing -> throwM (InvalidRel filepath)
rootPath :: Path Abs
rootPath = (MkPath (BS.singleton _slash))
--------------------------------------------------------------------------------
-- Path Conversion
-- | Convert any Path to a ByteString type.
toFilePath :: Path b -> ByteString
toFilePath (MkPath l) = l
-- | Convert an absolute Path to a ByteString type.
fromAbs :: Path Abs -> ByteString
fromAbs = toFilePath
-- | Convert a relative Path to a ByteString type.
fromRel :: Path Rel -> ByteString
fromRel = toFilePath
fromAny :: Either (Path Abs) (Path Rel) -> ByteString
fromAny = either toFilePath toFilePath
--------------------------------------------------------------------------------
-- Path 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.
--
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
-- "/file"
-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)
-- "/path/to/file"
-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)
-- "/file/lal"
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
-- "/file"
(</>) :: Path b -> Path Rel -> Path b
(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)
where
a' = if hasTrailingPathSeparator a
then a
else 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.
--
-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad"
-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad"
-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)
-- Nothing
-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)
-- Nothing
-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)
-- Nothing
stripDir :: MonadThrow m
=> Path b -> Path b -> m (Path Rel)
stripDir (MkPath p) (MkPath l) =
case stripPrefix p' l of
Nothing -> throwM (Couldn'tStripPrefixTPS p' l)
Just ok -> if BS.null ok
then throwM (Couldn'tStripPrefixTPS p' l)
else return (MkPath ok)
where
p' = addTrailingPathSeparator p
-- |Get all parents of a path.
--
-- >>> getAllParents (MkPath "/abs/def/dod")
-- ["/abs/def","/abs","/"]
-- >>> getAllParents (MkPath "/foo")
-- ["/"]
-- >>> getAllParents (MkPath "/")
-- []
getAllParents :: Path Abs -> [Path Abs]
getAllParents (MkPath p)
| np == BS.singleton pathSeparator = []
| otherwise = dirname (MkPath np) : getAllParents (dirname $ MkPath np)
where
np = normalise p
-- | Gets all path components.
--
-- >>> getAllComponents (MkPath "abs/def/dod")
-- ["abs","def","dod"]
-- >>> getAllComponents (MkPath "abs")
-- ["abs"]
getAllComponents :: Path Rel -> [Path Rel]
getAllComponents (MkPath p) = fmap MkPath . splitDirectories $ p
-- | Gets all path components after the "/" root directory.
--
-- >>> getAllComponentsAfterRoot (MkPath "/abs/def/dod")
-- ["abs","def","dod"]
-- >>> getAllComponentsAfterRoot (MkPath "/abs")
-- ["abs"]
getAllComponentsAfterRoot :: Path Abs -> [Path Rel]
getAllComponentsAfterRoot p = getAllComponents (fromJust $ stripDir rootPath p)
-- | Extract the directory name of a path.
--
-- >>> dirname (MkPath "/abc/def/dod")
-- "/abc/def"
-- >>> dirname (MkPath "/")
-- "/"
dirname :: Path Abs -> Path Abs
dirname (MkPath fp) = MkPath (takeDirectory fp)
-- | Extract the file part of a path.
--
--
-- The following properties hold:
--
-- @basename (p \<\/> a) == basename a@
--
-- Throws: `PathException` if given the root path "/"
--
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Rel)
-- Just "dod"
-- >>> basename (MkPath "abc/def/dod") :: Maybe (Path Rel)
-- Just "dod"
-- >>> basename (MkPath "dod") :: Maybe (Path Rel)
-- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Rel)
-- Nothing
basename :: MonadThrow m => Path b -> m (Path Rel)
basename (MkPath l)
| not (isAbsolute rl) = return $ MkPath rl
| otherwise = throwM RootDirHasNoBasename
where
rl = last . splitPath $ l
--------------------------------------------------------------------------------
-- Path Examination
-- | Is p a parent of the given location? Implemented in terms of
-- 'stripDir'. The bases must match.
--
-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")
-- True
-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")
-- True
-- >>> (MkPath "/") `isParentOf` (MkPath "/")
-- False
-- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad")
-- False
-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")
-- False
isParentOf :: Path b -> Path b -> Bool
isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel))
-- | Check whether the given Path is the root "/" path.
--
-- >>> isRootPath (MkPath "/lal/lad")
-- False
-- >>> isRootPath (MkPath "/")
-- True
isRootPath :: Path Abs -> Bool
isRootPath = (== rootPath)
--------------------------------------------------------------------------------
-- Path IO helpers
withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a
withAbsPath (MkPath p) action = action p
withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a
withRelPath (MkPath p) action = action p
------------------------
-- ByteString helpers
#if MIN_VERSION_bytestring(0,10,8)
#else
stripPrefix :: ByteString -> ByteString -> Maybe ByteString
stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b)
#endif
------------------------
-- QuasiQuoters
instance Lift (Path a) where
lift (MkPath bs) = AppE <$> [| MkPath . BS.pack |] <*> lift (BS.unpack bs)
qq :: (ByteString -> Q Exp) -> QuasiQuoter
qq quoteExp' =
QuasiQuoter
{ quoteExp = (\s -> quoteExp' . fromString $ s)
, quotePat = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a pattern)"
, quoteType = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a type)"
, quoteDec = \_ ->
fail "illegal QuasiQuote (allowed as expression only, used as a declaration)"
}
mkAbs :: ByteString -> Q Exp
mkAbs = either (error . show) lift . parseAbs
mkRel :: ByteString -> Q Exp
mkRel = either (error . show) lift . parseRel
-- | Quasiquote an absolute Path. This accepts Unicode Chars and will encode as UTF-8.
--
-- >>> [abs|/etc/profile|] :: Path Abs
-- "/etc/profile"
-- >>> [abs|/|] :: Path Abs
-- "/"
-- >>> [abs|/|] :: Path Abs
-- "/\239\131\144"
abs :: QuasiQuoter
abs = qq mkAbs
-- | Quasiquote a relative Path. This accepts Unicode Chars and will encode as UTF-8.
--
-- >>> [rel|etc|] :: Path Rel
-- "etc"
-- >>> [rel|bar/baz|] :: Path Rel
-- "bar/baz"
-- >>> [rel||] :: Path Rel
-- "\239\131\144"
rel :: QuasiQuoter
rel = qq mkRel

View File

@ -1,55 +0,0 @@
{-# LANGUAGE DeriveDataTypeable #-}
-- | Internal types and functions.
module HPath.Internal
(Path(..))
where
import Control.DeepSeq (NFData (..))
import Data.ByteString (ByteString)
import Data.Data
-- | The main Path type.
--
-- The type variable 'b' is either:
--
-- * Abs -- absolute path
-- * Rel -- relative path
--
-- Internally is a ByteString. The path is guaranteed to
-- be normalised and contain no trailing Path separators,
-- except for the '/' root path.
--
-- There are no duplicate path separators
-- @\/\/@, no @..@, no @.\/@, no @~\/@, etc.
data Path b = MkPath ByteString
deriving (Typeable)
-- | ByteString equality.
--
-- The following property holds:
--
-- @show x == show y ≡ x == y@
instance Eq (Path b) where
(==) (MkPath x) (MkPath y) = x == y
-- | ByteString ordering.
--
-- The following property holds:
--
-- @show x \`compare\` show y ≡ x \`compare\` y@
instance Ord (Path b) where
compare (MkPath x) (MkPath y) = compare x y
-- | Same as 'HPath.toFilePath'.
--
-- The following property holds:
--
-- @x == y ≡ show x == show y@
instance Show (Path b) where
show (MkPath x) = show x
instance NFData (Path b) where
rnf (MkPath x) = rnf x

37
path.cabal Normal file
View File

@ -0,0 +1,37 @@
name: path
version: 0.5.7
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: 20152016 FP Complete
category: Filesystem
build-type: Simple
cabal-version: >=1.8
extra-source-files: README.md, CHANGELOG
library
hs-source-dirs: src/
ghc-options: -Wall -O2
exposed-modules: Path, Path.Internal
build-depends: base >= 4 && <5
, exceptions
, filepath
, template-haskell
, deepseq
test-suite test
type: exitcode-stdio-1.0
main-is: Main.hs
hs-source-dirs: test
build-depends: HUnit
, base
, hspec
, mtl
, path
source-repository head
type: git
location: https://github.com/chrisdone/path.git

336
src/Path.hs Normal file
View File

@ -0,0 +1,336 @@
-- |
-- Module : Path
-- Copyright : © 20152016 FP Complete
-- License : BSD 3 clause
--
-- Maintainer : Chris Done <chrisdone@fpcomplete.com>
-- Stability : experimental
-- Portability : portable
--
-- Support for well-typed paths.
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
module Path
(-- * Types
Path
,Abs
,Rel
-- * Parsing
,parseAbsDir
,parseRelDir
,parseAbsFile
,parseRelFile
,PathParseException
-- * Constructors
,mkAbsDir
,mkRelDir
,mkAbsFile
,mkRelFile
-- * Operations
,(</>)
,stripDir
,isParentOf
,parent
,filename
-- * Conversion
,toFilePath
)
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)
-- | Exception when parsing a location.
data PathParseException
= InvalidAbsDir FilePath
| InvalidRelDir FilePath
| InvalidAbsFile FilePath
| InvalidRelFile FilePath
| Couldn'tStripPrefixDir FilePath FilePath
| InvalidTypeCombination
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)
parseAbsDir filepath =
if FilePath.isAbsolute filepath &&
not (null (normalizeDir filepath)) &&
not ("~/" `isPrefixOf` filepath) &&
not (hasParentDir filepath) &&
FilePath.isValid filepath
then return (DPath (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)
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 (DPath (normalizeDir filepath))
else throwM (InvalidRelDir filepath)
-- | Get a location for an absolute file.
--
-- Throws: 'PathParseException'
--
parseAbsFile :: MonadThrow m
=> FilePath -> m (Path Abs)
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 (FPath (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)
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 (FPath (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 (DPath str) ->
[|DPath $(return (LitE (StringL str))) :: Path Abs|]
_ -> error "Invalid Type"
-- | Make a 'Path Rel Dir'.
mkRelDir :: FilePath -> Q Exp
mkRelDir s =
case parseRelDir s of
Left err -> error (show err)
Right (DPath str) ->
[|DPath $(return (LitE (StringL str))) :: Path Rel|]
_ -> error "Invalid Type"
-- | 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 (FPath str) ->
[|FPath $(return (LitE (StringL str))) :: Path Abs|]
_ -> error "Invalid Type"
-- | Make a 'Path Rel File'.
mkRelFile :: FilePath -> Q Exp
mkRelFile s =
case parseRelFile s of
Left err -> error (show err)
Right (FPath str) ->
[|FPath $(return (LitE (StringL str))) :: Path Rel|]
_ -> error "Invalid Type"
--------------------------------------------------------------------------------
-- 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 -> FilePath
toFilePath (FPath l) = l
toFilePath (DPath l) = l
--------------------------------------------------------------------------------
-- 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 …)@
--
(</>) :: MonadThrow m => Path b -> Path Rel -> m (Path b)
(</>) (DPath a) (FPath b) = return $ FPath (a ++ b)
(</>) (DPath a) (DPath b) = return $ DPath (a ++ b)
(</>) _ _ = throwM InvalidTypeCombination
-- | 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 -> Path b -> m (Path Rel)
stripDir (DPath p) (FPath l) =
case stripPrefix p l of
Nothing -> throwM (Couldn'tStripPrefixDir p l)
Just "" -> throwM (Couldn'tStripPrefixDir p l)
Just ok -> return (FPath ok)
stripDir (DPath p) (DPath l) =
case stripPrefix p l of
Nothing -> throwM (Couldn'tStripPrefixDir p l)
Just "" -> throwM (Couldn'tStripPrefixDir p l)
Just ok -> return (DPath ok)
stripDir _ _ = throwM InvalidTypeCombination
-- | Is p a parent of the given location? Implemented in terms of
-- 'stripDir'. The bases must match.
-- Returns False if the first argument is not a directory path.
isParentOf :: Path b -> Path b -> Bool
isParentOf p@(DPath _) l@(DPath _) = isJust (stripDir p l)
isParentOf p@(DPath _) l@(FPath _) = isJust (stripDir p l)
isParentOf _ _ = False
-- | 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 -> Path Abs
parent (DPath fp) =
DPath (normalizeDir (FilePath.takeDirectory (FilePath.dropTrailingPathSeparator fp)))
parent (FPath fp) =
DPath (normalizeDir (FilePath.takeDirectory (FilePath.dropTrailingPathSeparator fp)))
-- | Extract the file/directory part of a path.
--
-- The following properties hold:
--
-- @filename (p \<\/> a) == filename a@
--
filename :: Path b -> Path Rel
filename (FPath l) =
FPath (normalizeFile (FilePath.takeFileName l))
filename (DPath l) =
DPath (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

61
src/Path/Internal.hs Normal file
View File

@ -0,0 +1,61 @@
{-# LANGUAGE DeriveDataTypeable #-}
-- TODO: - remove undefined in Ord instance
-- - use viewpatterns/patternsynonyms so we don't need to
-- export the constructors
-- | Internal types and functions.
module Path.Internal
(Path(..))
where
import Control.DeepSeq (NFData (..))
import Data.Data
-- | Path of some base and type.
--
-- Internally is a string. The string can be of two formats only:
--
-- 1. File format: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@
-- 2. Directory format: @foo\/@, @\/foo\/bar\/@
--
-- All directories end in a trailing separator. There are no duplicate
-- path separators @\/\/@, no @..@, no @.\/@, no @~\/@, etc.
data Path b = FPath FilePath
| DPath FilePath
deriving (Typeable)
-- | String equality.
--
-- The following property holds:
--
-- @show x == show y ≡ x == y@
instance Eq (Path b) where
(==) (FPath x) (FPath y) = x == y
(==) (DPath x) (DPath y) = x == y
(==) _ _ = False
-- | String ordering.
--
-- The following property holds:
--
-- @show x \`compare\` show y ≡ x \`compare\` y@
instance Ord (Path b) where
compare (FPath x) (FPath y) = compare x y
compare (DPath x) (DPath y) = compare x y
compare _ _ = undefined
-- | Same as 'Path.toFilePath'.
--
-- The following property holds:
--
-- @x == y ≡ show x == show y@
instance Show (Path b) where
show (FPath x) = show x
show (DPath x) = show x
instance NFData (Path b) where
rnf (FPath x) = rnf x
rnf (DPath x) = rnf x

225
test/Main.hs Normal file
View File

@ -0,0 +1,225 @@
{-# LANGUAGE TemplateHaskell #-}
-- | Test suite.
module Main where
import Control.Applicative
import Control.Monad
import Data.Maybe
import Data.Monoid
import Path
import Path.Internal
import Test.Hspec
-- | Test suite entry point, returns exit failure if any test fails.
main :: IO ()
main = hspec spec
-- | Test suite.
spec :: Spec
spec =
do describe "Parsing: Path Abs Dir" parseAbsDirSpec
describe "Parsing: Path Rel Dir" parseRelDirSpec
describe "Parsing: Path Abs File" parseAbsFileSpec
describe "Parsing: Path Rel File" parseRelFileSpec
describe "Operations: (</>)" operationAppend
describe "Operations: stripDir" operationStripDir
describe "Operations: isParentOf" operationIsParentOf
describe "Operations: parent" operationParent
describe "Operations: filename" operationFilename
describe "Restrictions" restrictions
-- | Restricting the input of any tricks.
restrictions :: Spec
restrictions =
do parseFails "~/"
parseFails "~/foo"
parseFails "~/foo/bar"
parseFails "../"
parseFails ".."
parseFails "."
parseFails "/.."
parseFails "/foo/../bar/"
parseFails "/foo/bar/.."
where parseFails x =
it (show x ++ " should be rejected")
(isNothing (void (parseAbsDir x) <|>
void (parseRelDir x) <|>
void (parseAbsFile x) <|>
void (parseRelFile x)))
-- | The 'filename' operation.
operationFilename :: Spec
operationFilename =
do it "filename ($(mkAbsDir parent) </> filename $(mkRelFile filename)) == $(mkRelFile filename)"
(filename ($(mkAbsDir "/home/chris/") </>
filename $(mkRelFile "bar.txt")) ==
$(mkRelFile "bar.txt"))
it "filename ($(mkRelDir parent) </> filename $(mkRelFile filename)) == $(mkRelFile filename)"
(filename ($(mkRelDir "home/chris/") </>
filename $(mkRelFile "bar.txt")) ==
$(mkRelFile "bar.txt"))
-- | The 'parent' operation.
operationParent :: Spec
operationParent =
do it "parent (parent </> child) == parent"
(parent ($(mkAbsDir "/foo") </>
$(mkRelDir "bar")) ==
$(mkAbsDir "/foo"))
it "parent \"\" == \"\""
(parent $(mkAbsDir "/") ==
$(mkAbsDir "/"))
it "parent (parent \"\") == \"\""
(parent (parent $(mkAbsDir "/")) ==
$(mkAbsDir "/"))
-- | The 'isParentOf' operation.
operationIsParentOf :: Spec
operationIsParentOf =
do it "isParentOf parent (parent </> child)"
(isParentOf
$(mkAbsDir "///bar/")
($(mkAbsDir "///bar/") </>
$(mkRelFile "bar/foo.txt")))
it "isParentOf parent (parent </> child)"
(isParentOf
$(mkRelDir "bar/")
($(mkRelDir "bar/") </>
$(mkRelFile "bob/foo.txt")))
-- | The 'stripDir' operation.
operationStripDir :: Spec
operationStripDir =
do it "stripDir parent (parent </> child) = child"
(stripDir $(mkAbsDir "///bar/")
($(mkAbsDir "///bar/") </>
$(mkRelFile "bar/foo.txt")) ==
Just $(mkRelFile "bar/foo.txt"))
it "stripDir parent (parent </> child) = child"
(stripDir $(mkRelDir "bar/")
($(mkRelDir "bar/") </>
$(mkRelFile "bob/foo.txt")) ==
Just $(mkRelFile "bob/foo.txt"))
it "stripDir parent parent = _|_"
(stripDir $(mkAbsDir "/home/chris/foo")
$(mkAbsDir "/home/chris/foo") ==
Nothing)
-- | The '</>' operation.
operationAppend :: Spec
operationAppend =
do it "AbsDir + RelDir = AbsDir"
($(mkAbsDir "/home/") </>
$(mkRelDir "chris") ==
$(mkAbsDir "/home/chris/"))
it "AbsDir + RelFile = AbsFile"
($(mkAbsDir "/home/") </>
$(mkRelFile "chris/test.txt") ==
$(mkAbsFile "/home/chris/test.txt"))
it "RelDir + RelDir = RelDir"
($(mkRelDir "home/") </>
$(mkRelDir "chris") ==
$(mkRelDir "home/chris"))
it "RelDir + RelFile = RelFile"
($(mkRelDir "home/") </>
$(mkRelFile "chris/test.txt") ==
$(mkRelFile "home/chris/test.txt"))
-- | Tests for the tokenizer.
parseAbsDirSpec :: Spec
parseAbsDirSpec =
do failing ""
failing "./"
failing "~/"
failing "foo.txt"
succeeding "/" (Path "/")
succeeding "//" (Path "/")
succeeding "///foo//bar//mu/" (Path "/foo/bar/mu/")
succeeding "///foo//bar////mu" (Path "/foo/bar/mu/")
succeeding "///foo//bar/.//mu" (Path "/foo/bar/mu/")
where failing x = parserTest parseAbsDir x Nothing
succeeding x with = parserTest parseAbsDir x (Just with)
-- | Tests for the tokenizer.
parseRelDirSpec :: Spec
parseRelDirSpec =
do failing ""
failing "/"
failing "//"
failing "~/"
failing "/"
failing "./"
failing "././"
failing "//"
failing "///foo//bar//mu/"
failing "///foo//bar////mu"
failing "///foo//bar/.//mu"
succeeding "..." (Path ".../")
succeeding "foo.bak" (Path "foo.bak/")
succeeding "./foo" (Path "foo/")
succeeding "././foo" (Path "foo/")
succeeding "./foo/./bar" (Path "foo/bar/")
succeeding "foo//bar//mu//" (Path "foo/bar/mu/")
succeeding "foo//bar////mu" (Path "foo/bar/mu/")
succeeding "foo//bar/.//mu" (Path "foo/bar/mu/")
where failing x = parserTest parseRelDir x Nothing
succeeding x with = parserTest parseRelDir x (Just with)
-- | Tests for the tokenizer.
parseAbsFileSpec :: Spec
parseAbsFileSpec =
do failing ""
failing "./"
failing "~/"
failing "./foo.txt"
failing "/"
failing "//"
failing "///foo//bar//mu/"
succeeding "/..." (Path "/...")
succeeding "/foo.txt" (Path "/foo.txt")
succeeding "///foo//bar////mu.txt" (Path "/foo/bar/mu.txt")
succeeding "///foo//bar/.//mu.txt" (Path "/foo/bar/mu.txt")
where failing x = parserTest parseAbsFile x Nothing
succeeding x with = parserTest parseAbsFile x (Just with)
-- | Tests for the tokenizer.
parseRelFileSpec :: Spec
parseRelFileSpec =
do failing ""
failing "/"
failing "//"
failing "~/"
failing "/"
failing "./"
failing "//"
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)
-- | Parser test.
parserTest :: (Show a1,Show a,Eq a1)
=> (a -> Maybe a1) -> a -> Maybe a1 -> SpecWith ()
parserTest parser input expected =
it ((case expected of
Nothing -> "Failing: "
Just{} -> "Succeeding: ") <>
"Parsing " <>
show input <>
" " <>
case expected of
Nothing -> "should fail."
Just x -> "should succeed with: " <> show x)
(actual == expected)
where actual = parser input