74 Commits
0.6.0 ... 0.8.0

Author SHA1 Message Date
4d71ad08ce Release 0.8.0 2016-06-05 17:56:31 +02:00
92017ab630 Make createRegularFile and createDir accept FileMode parameter 2016-06-05 17:46:25 +02:00
16af98b32d Be more specific about Overwrite mode 2016-06-05 16:38:54 +02:00
6da01e382f Improve documentation 2016-06-05 16:31:08 +02:00
ed06543981 Proper GHC conditionals to fix compiler warnings 2016-06-05 16:16:41 +02:00
d3eb2fc254 Fix build with GHC-7.8 2016-06-05 16:12:51 +02:00
a1eb06324f Rm unused imports 2016-06-05 16:09:34 +02:00
d12ce30f57 Fix docs and rename RecursiveMode to RecursiveErrorMode 2016-06-05 16:07:46 +02:00
7a6f0e8728 Fix spelling 2016-06-05 16:00:15 +02:00
7ed5829d47 Fix documentation 2016-06-05 15:57:41 +02:00
d708f80a1f TESTS: don't assume ordering of exceptions 2016-06-05 15:37:26 +02:00
f07619b7c6 TESTS: fix before/after 2016-06-05 15:25:57 +02:00
c5bcb90b65 TESTS: don't use lazy IO -.- 2016-06-05 14:55:21 +02:00
4f047dbc77 TESTS: import unsafePerformIO from System.IO.Unsafe 2016-06-05 14:46:45 +02:00
bc348c7dd5 TESTS: less side effects plz 2016-06-05 14:33:53 +02:00
5d1c5cc2ce Fix linter warning 2016-06-05 03:26:05 +02:00
8f6ca81d22 Add tests to RecreateSymlinkOverwriteSpec 2016-06-05 03:22:35 +02:00
a27d4ed55d Improve documentation 2016-06-05 03:22:11 +02:00
64ae6db83a New API: use CopyMode for overwriting and introduce RecursiveMode
This allows to specify the behavior on recursive operations,
such that one can collect failures instead of dying on the first
failure.
2016-06-05 03:13:33 +02:00
2a0a88a96d Release 0.7.5 2016-06-04 00:39:03 +02:00
69dbf6714d Relicense to BSD3 2016-06-04 00:39:03 +02:00
2d96311b33 TRAVIS: install missing hscolour 2016-06-01 18:53:54 +02:00
21668f12fe TRAVIS: fix update-gh-pages.sh 2016-06-01 18:45:49 +02:00
6e37e18bc8 TRAVIS: fix cwd 2016-06-01 18:35:47 +02:00
ae24f87c74 TRAVIS: make update-gh-pages executable 2016-06-01 18:26:06 +02:00
9f6734e700 TRAVIS: fix update-gh-pages.sh 2016-06-01 15:34:30 +02:00
741c510b91 TRAVIS: automatic gh-pages pushing 2016-06-01 15:30:15 +02:00
bb590a7692 Improve documentation 2016-05-31 16:21:14 +02:00
641e23c3ef Release 0.7.3 2016-05-30 17:16:37 +02:00
82ea75cc88 Small documentation fix 2016-05-30 17:16:24 +02:00
abf043be14 Add examples to README 2016-05-30 16:02:08 +02:00
10adc4be27 TRAVIS: use CABALVER=1.24 for GHCVER=7.10.2 2016-05-30 13:33:22 +02:00
a176e4970b TRAVIS: add CABALVER=1.24 GHCVER=8.0.1 2016-05-30 13:32:56 +02:00
08de2ebefb Move RelC class from HPath.Internal to HPath 2016-05-30 13:02:34 +02:00
d15d7761c1 Don't expose HPath.Internal 2016-05-30 13:01:47 +02:00
7e924d3386 Remove benchmarks
We don't really need this.
2016-05-29 22:45:26 +02:00
21fccc9ca9 Fix build with ghc < 7.10 2016-05-29 18:57:55 +02:00
79dbcd8b55 Add type signature to pattern synonym 2016-05-29 17:56:51 +02:00
b603f72407 Release 0.7.2 2016-05-29 17:47:22 +02:00
98ca6c5d86 Sort module list alphabetically 2016-05-29 17:44:00 +02:00
8d948366f9 Add hspec for createSymlink 2016-05-29 17:43:43 +02:00
86e7496917 Re-add missing spec modules so they show up in sdist 2016-05-29 17:38:27 +02:00
1b9b8cc886 Set test formatter to progress 2016-05-29 17:32:22 +02:00
395621b27a Fix tests for sdist
We now create the necessary directories and files
for the tests on-the-fly.
2016-05-29 17:29:13 +02:00
51da8bf5c2 HPath.IO: add createSymlink 2016-05-29 17:28:12 +02:00
bebc96fa6d Add posix note to README 2016-05-24 15:55:36 +02:00
08fa277b31 Release 0.7.1 2016-05-24 15:36:34 +02:00
51609781b2 Add makeRelative and makeValid 2016-05-24 15:31:14 +02:00
3cb3a822d7 Add test to equalFilePath 2016-05-24 15:30:56 +02:00
7fa4c041a9 Remove -Wno-redundant-constraints since it's only in ghc >= 8.0.1 2016-05-24 03:31:01 +02:00
e66074af1c Fix stripSuffix' for bytestring < 0.10.8 2016-05-24 03:29:40 +02:00
4032629407 Add TODO 2016-05-24 03:26:07 +02:00
f2fe5a3419 Hide wrong -Wredundant-constraints messages 2016-05-24 03:26:07 +02:00
5ac7450495 Small import fix 2016-05-24 03:26:07 +02:00
b55cf6d9f3 Fix for bytestring versions less than 0.10.8 2016-05-24 03:26:01 +02:00
ae9a806c2e Fix to latest sendfile version to simplify imports 2016-05-24 03:13:36 +02:00
9c199c6da2 Rearrange, prettify and improve haddock
This also matches the documentation order from the
filepath package more.
2016-05-24 02:16:16 +02:00
eb72fce33f Add splitSearchPath, getSearchPath and stripExtension 2016-05-24 02:07:04 +02:00
65bb09d133 Update README 2016-05-23 13:52:34 +02:00
908513da2b Prettify doctests 2016-05-23 00:52:27 +02:00
47dd729e8a Small documentation improvements 2016-05-22 13:41:39 +02:00
620550dab4 Minor documentation fixes 2016-05-22 13:28:20 +02:00
ebab5355bc Beautify 2016-05-19 01:29:08 +02:00
8fdf1bf956 Add gitter link 2016-05-19 01:28:11 +02:00
39913faed6 Add hackage icon to README 2016-05-18 15:58:28 +02:00
5ed249f5d6 Fix haddock 2016-05-18 14:03:50 +02:00
a8ccfc2587 Release 0.7.0 2016-05-18 14:02:08 +02:00
8fec862304 Rm redundant import 2016-05-18 13:48:38 +02:00
646fe7cfea Doc update 2016-05-18 13:42:31 +02:00
1bf27258c1 Uhm 2016-05-18 13:33:17 +02:00
797dcaf725 Backport changes from posix-paths PR:
* add isFileName
* add hasParentDir
* add hiddenFile
* add our own openFd version for more control
* small documentation improvements
* add a getDirectoryContents' version that works on Fd
* fix linting warnings
* lift version constraints in benchmark

Also adjust HPath.IO to work with the new API.
2016-05-18 04:11:40 +02:00
0fa66cd581 Use sendfile for copying and read/write as fallback 2016-05-18 03:47:39 +02:00
ee3ace362b HPath.IO: minor doc fix 2016-05-10 12:05:55 +02:00
05fcad14f1 HPath.IO.Errors: minor documentation fix 2016-05-10 02:02:05 +02:00
144 changed files with 2694 additions and 1761 deletions

View File

@@ -9,15 +9,22 @@ matrix:
include:
- env: CABALVER=1.22 GHCVER=7.8.4
addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.10.2
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=7.10.2
addons: {apt: {packages: [cabal-install-1.24,ghc-7.10.2], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.1
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
- env: CABALVER=head GHCVER=head
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
allow_failures:
- env: CABALVER=head GHCVER=head
env:
global:
- secure: q++z4DGwOHYjmed00oxMnGhBTzOBzKYunXvVcnCEmvmzW3qZERtXj3B7CLW4vRtmBlo3SiM0fb25NeYao+ByzTjo8jk9noiBVZvffwRmlKCeVwYx7T4/rsDhfV97k2JOeahBSgxWNuTkt+5gv07HpKdTiIxJsiv/QdBxQeq6/Ly6dyRskmCt+VuFvQg+cqPMugxIXtY6F7eZ1zgl/LxlamWjO3E4lX0Myf4o8+SU1HRDVkkVe+ytnRcVcYI2FHuFV/sSoDMTweXQToA9roVjOkfhq4rGlPCuXJkBPyZW2otLXgAV7I2kjwgxqmS5Yw752CcFjMMbG6R1u8sEAcGrJNKHfx8sKqBwI0AVoq4CJn+nKSElTDl0KI1mqazmazK4/mddkD9NGIVXCFmw4b+YGf1uDj8FAR94UmOiEFkEObGkQxG1XK/uzDaUJ1tO3MYXjPPEIE89BJORo+ZskmKFEoqbrBR/vEjbXxJHWP7SaaoM+mWpMiSssEFb/Z5mDBFPb2P/2f7nO4ZDfOYp/9hZdBvDaVM8FmTQfzF6jIUIOFmeeiSZWIBAHoDfdZDRrM/hC5JzqfMumW9frwllsQtYytkAsUqlNnCW86jlc5/5L6D8eY2NERFI2DRqrBi7bP2AfYXsozY0gMO1RL5+iQSQVKlPhk6IyAJYCWCYnrA+dz4=
before_install:
- sudo apt-get install -y hscolour
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
install:
@@ -32,6 +39,7 @@ script:
- cabal test
- cabal check
- cabal sdist
- cabal haddock --hyperlink-source --html-location=https://hackage.haskell.org/package/\$pkg-\$version/docs/
# check that the generated source-distribution can be built & installed
- export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
cd dist/;
@@ -41,7 +49,11 @@ script:
else
echo "expected '$SRC_TGZ' not found";
exit 1;
fi
fi;
cd ..
after_script:
- ./update-gh-pages.sh
notifications:
email:

View File

@@ -1,3 +1,27 @@
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

358
LICENSE
View File

@@ -1,340 +1,30 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (c) Julian Ospald
Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
All rights reserved.
Preamble
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Lesser General Public License instead.) You can apply it to
your programs, too.
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
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.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License along
with this program; if not, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) year name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License.
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,6 +1,6 @@
# HPath
[![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/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)
Support for well-typed paths in Haskell. Also provides ByteString based filepath
manipulation.
@@ -28,6 +28,8 @@ so it is forked as well and merged into this library.
* safe filepath manipulation, never using String as filepath, but ByteString
* still allowing sufficient control to interact with the underlying low-level calls
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...
@@ -43,9 +45,43 @@ so it is forked as well and merged into this library.
## Differences to 'posix-paths'
* `hasTrailingPathSeparator` behaves in the same way as `System.FilePath`
* `dropTrailingPathSeparator` behaves in the same way as `System.FilePath`
* added various functions like `isValid`, `normalise` and `equalFilePath`
* uses the `word8` package for save word8 literals instead of `OverloadedStrings`
* has custom versions of `openFd` and `getDirectoryContents`
* `hasTrailingPathSeparator` and `dropTrailingPathSeparator` behave in the same way as their `System.FilePath` counterpart
* added various functions:
* `equalFilePath`
* `getSearchPath`
* `hasParentDir`
* `hiddenFile`
* `isFileName`
* `isValid`
* `makeRelative`
* `makeValid`
* `normalise`
* `splitSearchPath`
* `stripExtension`
* 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
## Examples in ghci
Start ghci via `cabal repl`:
```hs
-- enable OverloadedStrings
:set -XOverloadedStrings
-- import HPath.IO
import HPath.IO
-- parse an absolute path
abspath <- parseAbs "/home"
-- parse a relative path (e.g. user users home directory)
relpath <- parseRel "jule"
-- concatenate paths
let newpath = abspath </> relpath
-- get file type
getFileType newpath
-- return all contents of that directory
getDirsFiles newpath
-- return all contents of the parent directory
getDirsFiles (dirname newpath)
```

View File

@@ -1,90 +0,0 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
import Control.Applicative
import Control.Monad
import System.Directory
import System.FilePath ((</>))
import System.Posix.ByteString.FilePath
import System.Posix.Directory.ByteString as PosixBS
import System.Posix.Directory.Traversals
import qualified System.Posix.FilePath as PosixBS
import System.Posix.Files.ByteString
import Control.Exception
import qualified Data.ByteString.Char8 as BS
import System.Environment (getArgs, withArgs)
import System.IO.Error
import System.IO.Unsafe
import System.Process (system)
import Criterion.Main
-- | Based on code from 'Real World Haskell', at
-- http://book.realworldhaskell.org/read/io-case-study-a-library-for-searching-the-filesystem.html#id620419
listFilesRecursive :: FilePath -> IO [FilePath]
listFilesRecursive topdir = do
names <- System.Directory.getDirectoryContents topdir
let properNames = filter (`notElem` [".", ".."]) names
paths <- forM properNames $ \name -> do
let path = topdir </> name
isDir <- doesDirectoryExist path
if isDir
then listFilesRecursive path
else return [path]
return (topdir : concat paths)
----------------------------------------------------------
getDirectoryContentsBS :: RawFilePath -> IO [RawFilePath]
getDirectoryContentsBS path =
modifyIOError ((`ioeSetFileName` (BS.unpack path)) .
(`ioeSetLocation` "getDirectoryContentsBS")) $ do
bracket
(PosixBS.openDirStream path)
PosixBS.closeDirStream
loop
where
loop dirp = do
e <- PosixBS.readDirStream dirp
if BS.null e then return [] else do
es <- loop dirp
return (e:es)
-- | similar to 'listFilesRecursive, but uses RawFilePaths
listFilesRecursiveBS :: RawFilePath -> IO [RawFilePath]
listFilesRecursiveBS topdir = do
names <- getDirectoryContentsBS topdir
let properNames = filter (`notElem` [".", ".."]) names
paths <- forM properNames $ \name -> unsafeInterleaveIO $ do
let path = PosixBS.combine topdir name
isDir <- isDirectory <$> getFileStatus path
if isDir
then listFilesRecursiveBS path
else return [path]
return (topdir : concat paths)
----------------------------------------------------------
benchTraverse :: RawFilePath -> IO ()
benchTraverse = traverseDirectory (\() p -> BS.putStrLn p) ()
main :: IO ()
main = do
args <- getArgs
let (d,otherArgs) = case args of
[] -> ("/usr/local",[])
x:xs -> (x,xs)
withArgs otherArgs $ defaultMain
[ bench "traverse (FilePath)" $ nfIO $ listFilesRecursive d >>= mapM_ putStrLn
, bench "traverse (RawFilePath)" $ nfIO $ listFilesRecursiveBS (BS.pack d) >>= mapM_ BS.putStrLn
, bench "allDirectoryContents" $ nfIO $ allDirectoryContents (BS.pack d) >>= mapM_ BS.putStrLn
, bench "allDirectoryContents'" $ nfIO $ allDirectoryContents' (BS.pack d) >>= mapM_ BS.putStrLn
, bench "traverseDirectory" $ nfIO $ benchTraverse (BS.pack d)
, bench "unix find" $ nfIO $ void $ system ("find " ++ d)
]

View File

@@ -1,8 +1,8 @@
name: hpath
version: 0.6.0
version: 0.8.0
synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood.
license: GPL-2
license: BSD3
license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de>
maintainer: Julian Ospald <hasufell@posteo.de>
@@ -12,7 +12,6 @@ build-type: Simple
cabal-version: >=1.14
extra-source-files: README.md
CHANGELOG
benchmarks/*.hs
cbits/dirutils.h
doctests-hpath.hs
doctests-posix.hs
@@ -20,21 +19,26 @@ extra-source-files: README.md
library
hs-source-dirs: src/
default-language: Haskell2010
ghc-options: -Wall
if impl(ghc >= 8.0)
ghc-options: -Wall -Wno-redundant-constraints
else
ghc-options: -Wall
c-sources: cbits/dirutils.c
exposed-modules: HPath,
HPath.IO,
HPath.IO.Errors,
HPath.IO.Utils,
HPath.Internal,
System.Posix.Directory.Foreign,
System.Posix.Directory.Traversals,
System.Posix.FD,
System.Posix.FilePath
other-modules: HPath.Internal
build-depends: base >= 4.2 && <5
, bytestring >= 0.9.2.0
, deepseq
, exceptions
, hspec
, simple-sendfile >= 0.2.24
, unix >= 2.5
, unix-bytestring
, utf8-string
@@ -71,22 +75,26 @@ test-suite spec
Hs-Source-Dirs: test
Main-Is: Main.hs
other-modules:
Spec
HPath.IO.CopyDirRecursiveSpec
HPath.IO.CanonicalizePathSpec
HPath.IO.CopyDirRecursiveCollectFailuresSpec
HPath.IO.CopyDirRecursiveOverwriteSpec
HPath.IO.CopyFileSpec
HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyFileOverwriteSpec
HPath.IO.CopyFileSpec
HPath.IO.CreateDirSpec
HPath.IO.CreateRegularFileSpec
HPath.IO.CreateSymlinkSpec
HPath.IO.DeleteDirRecursiveSpec
HPath.IO.DeleteDirSpec
HPath.IO.DeleteFileSpec
HPath.IO.GetDirsFilesSpec
HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileSpec
HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec
HPath.IO.RecreateSymlinkOverwriteSpec
HPath.IO.RecreateSymlinkSpec
HPath.IO.RenameFileSpec
Spec
Utils
GHC-Options: -Wall
Build-Depends: base
@@ -96,25 +104,9 @@ test-suite spec
, hspec >= 1.3
, process
, unix
, unix-bytestring
, utf8-string
benchmark bench.hs
default-language: Haskell2010
type: exitcode-stdio-1.0
hs-source-dirs: benchmarks
main-is: Bench.hs
build-depends:
base,
hpath,
bytestring,
unix,
directory >= 1.1 && < 1.3,
filepath >= 1.2 && < 1.4,
process >= 1.0 && < 1.3,
criterion >= 0.6 && < 0.9
ghc-options: -O2
source-repository head
type: git
location: https://github.com/hasufell/hpath

View File

@@ -24,6 +24,7 @@ module HPath
,Fn
,PathParseException
,PathException
,RelC
-- * PatternSynonyms/ViewPatterns
,pattern Path
-- * Path Parsing
@@ -45,9 +46,6 @@ module HPath
,withAbsPath
,withRelPath
,withFnPath
-- * ByteString operations
,fpToString
,userStringToFP
)
where
@@ -57,10 +55,10 @@ import Control.Monad.Catch (MonadThrow(..))
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.Data
import qualified Data.List as L
import Data.Maybe
import Data.Word8
import HPath.Internal
@@ -92,12 +90,17 @@ data PathException = RootDirHasNoBasename
deriving (Show,Typeable)
instance Exception PathException
class RelC m
instance RelC Rel
instance RelC Fn
--------------------------------------------------------------------------------
-- PatternSynonyms
#if __GLASGOW_HASKELL__ >= 710
pattern Path :: ByteString -> Path a
#endif
pattern Path x <- (MkPath x)
--------------------------------------------------------------------------------
@@ -109,19 +112,19 @@ pattern Path x <- (MkPath x)
--
-- Throws: 'PathParseException'
--
-- >>> parseAbs "/abc" :: Maybe (Path Abs)
-- >>> parseAbs "/abc" :: Maybe (Path Abs)
-- Just "/abc"
-- >>> parseAbs "/" :: Maybe (Path Abs)
-- >>> parseAbs "/" :: Maybe (Path Abs)
-- Just "/"
-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)
-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)
-- Just "/abc/def"
-- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs)
-- Just "/abc/def/"
-- >>> parseAbs "abc" :: Maybe (Path Abs)
-- >>> parseAbs "abc" :: Maybe (Path Abs)
-- Nothing
-- >>> parseAbs "" :: Maybe (Path Abs)
-- >>> parseAbs "" :: Maybe (Path Abs)
-- Nothing
-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)
-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)
-- Nothing
parseAbs :: MonadThrow m
=> ByteString -> m (Path Abs)
@@ -141,23 +144,23 @@ parseAbs filepath =
--
-- Throws: 'PathParseException'
--
-- >>> parseRel "abc" :: Maybe (Path Rel)
-- >>> parseRel "abc" :: Maybe (Path Rel)
-- Just "abc"
-- >>> parseRel "def/" :: Maybe (Path Rel)
-- >>> parseRel "def/" :: Maybe (Path Rel)
-- Just "def/"
-- >>> parseRel "abc/def" :: Maybe (Path Rel)
-- >>> parseRel "abc/def" :: Maybe (Path Rel)
-- Just "abc/def"
-- >>> parseRel "abc/def/." :: Maybe (Path Rel)
-- >>> parseRel "abc/def/." :: Maybe (Path Rel)
-- Just "abc/def/"
-- >>> parseRel "/abc" :: Maybe (Path Rel)
-- >>> parseRel "/abc" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "" :: Maybe (Path Rel)
-- >>> parseRel "" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "abc/../foo" :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel "." :: Maybe (Path Rel)
-- >>> parseRel "." :: Maybe (Path Rel)
-- Nothing
-- >>> parseRel ".." :: Maybe (Path Rel)
-- >>> parseRel ".." :: Maybe (Path Rel)
-- Nothing
parseRel :: MonadThrow m
=> ByteString -> m (Path Rel)
@@ -176,25 +179,25 @@ parseRel filepath =
--
-- Throws: 'PathParseException'
--
-- >>> parseFn "abc" :: Maybe (Path Fn)
-- >>> parseFn "abc" :: Maybe (Path Fn)
-- Just "abc"
-- >>> parseFn "..." :: Maybe (Path Fn)
-- >>> parseFn "..." :: Maybe (Path Fn)
-- Just "..."
-- >>> parseFn "def/" :: Maybe (Path Fn)
-- >>> parseFn "def/" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/def" :: Maybe (Path Fn)
-- >>> parseFn "abc/def" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/def/." :: Maybe (Path Fn)
-- >>> parseFn "abc/def/." :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "/abc" :: Maybe (Path Fn)
-- >>> parseFn "/abc" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "" :: Maybe (Path Fn)
-- >>> parseFn "" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "abc/../foo" :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn "." :: Maybe (Path Fn)
-- >>> parseFn "." :: Maybe (Path Fn)
-- Nothing
-- >>> parseFn ".." :: Maybe (Path Fn)
-- >>> parseFn ".." :: Maybe (Path Fn)
-- Nothing
parseFn :: MonadThrow m
=> ByteString -> m (Path Fn)
@@ -237,13 +240,13 @@ fromRel = toFilePath
-- because this library is IO-agnostic and makes no assumptions about
-- file types.
--
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)
-- "/file"
-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)
-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)
-- "/path/to/file"
-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)
-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)
-- "/file/lal"
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)
-- "/file/"
(</>) :: RelC r => Path b -> Path r -> Path b
(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)
@@ -257,15 +260,15 @@ fromRel = toFilePath
--
-- The bases must match.
--
-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)
-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad"
-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)
-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)
-- Just "fad"
-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)
-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)
-- Nothing
-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)
-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)
-- Nothing
-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)
-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)
-- Nothing
stripDir :: MonadThrow m
=> Path b -> Path b -> m (Path Rel)
@@ -281,15 +284,15 @@ stripDir (MkPath p) (MkPath l) =
-- | 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")
-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")
-- True
-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")
-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")
-- True
-- >>> (MkPath "/") `isParentOf` (MkPath "/")
-- >>> (MkPath "/") `isParentOf` (MkPath "/")
-- False
-- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad")
-- False
-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")
-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")
-- False
isParentOf :: Path b -> Path b -> Bool
isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel))
@@ -333,7 +336,7 @@ dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
--
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)
-- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- Nothing
basename :: MonadThrow m => Path b -> m (Path Fn)
basename (MkPath l)

View File

@@ -1,7 +1,7 @@
-- |
-- Module : HPath.IO
-- Copyright : © 2016 Julian Ospald
-- License : GPL-2
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
@@ -26,9 +26,9 @@
-- exception handling is kept.
--
-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`
-- are not explicitly supported right now. Calling any of these
-- functions on such a file may throw an exception or just do
-- nothing.
-- 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 PackageImports #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -37,14 +37,13 @@ module HPath.IO
(
-- * Types
FileType(..)
, RecursiveErrorMode(..)
, CopyMode(..)
-- * File copying
, copyDirRecursive
, copyDirRecursiveOverwrite
, recreateSymlink
, copyFile
, copyFileOverwrite
, easyCopy
, easyCopyOverwrite
-- * File deletion
, deleteFile
, deleteDir
@@ -56,10 +55,10 @@ module HPath.IO
-- * File creation
, createRegularFile
, createDir
, createSymlink
-- * File renaming/moving
, renameFile
, moveFile
, moveFileOverwrite
-- * File permissions
, newFilePerms
, newDirPerms
@@ -79,13 +78,14 @@ import Control.Applicative
)
import Control.Exception
(
bracket
, bracketOnError
IOException
, bracket
, throwIO
)
import Control.Monad
(
void
unless
, void
, when
)
import Data.ByteString
@@ -96,6 +96,13 @@ import Data.Foldable
(
for_
)
import Data.IORef
(
IORef
, modifyIORef
, newIORef
, readIORef
)
import Data.Maybe
(
catMaybes
@@ -107,6 +114,8 @@ import Data.Word
import Foreign.C.Error
(
eEXIST
, eINVAL
, eNOSYS
, eNOTEMPTY
, eXDEV
)
@@ -129,13 +138,17 @@ import GHC.IO.Exception
import HPath
import HPath.Internal
import HPath.IO.Errors
import HPath.IO.Utils
import Prelude hiding (readFile)
import System.IO.Error
(
catchIOError
, ioeGetErrorType
)
import System.Linux.Sendfile
(
sendfileFd
, FileRange(..)
)
import System.Posix.ByteString
(
exclusive
@@ -172,6 +185,10 @@ import System.Posix.Files.ByteString
import qualified System.Posix.Files.ByteString as PF
import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
import System.Posix.FD
(
openFd
)
import qualified System.Posix.Directory.Traversals as SPDT
import qualified System.Posix.Directory.Foreign as SPDF
import qualified System.Posix.Process.ByteString as SPP
@@ -202,6 +219,26 @@ data FileType = Directory
-- |The error mode for any recursive operation.
--
-- On `FailEarly` the whole operation fails immediately if any of the
-- recursive sub-operations fail, which is sort of the default
-- for IO operations.
--
-- On `CollectFailures` skips errors in the recursion and keeps on recursing.
-- However all errors are collected in the `RecursiveFailure` error type,
-- which is raised finally if there was any error.
data RecursiveErrorMode = FailEarly
| CollectFailures
-- |The mode for copy and file moves.
-- Overwrite mode is usually not very well defined, but is a convenience
-- shortcut.
data CopyMode = Strict -- ^ fail if any target exists
| Overwrite -- ^ overwrite targets
--------------------
@@ -210,8 +247,24 @@ data FileType = Directory
-- |Copies a directory recursively to the given destination.
-- Does not follow symbolic links.
-- |Copies the contents of a directory recursively to the given destination.
-- Does not follow symbolic links. This behaves more or less like:
--
-- @
-- mkdir \/destination\/dir
-- cp -R \/source\/dir\/* \/destination\/dir\/
-- @
--
-- 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.
--
-- Note that there is no guaranteed ordering of the exceptions
-- contained within `RecursiveFailure` in `CollectFailures` RecursiveErrorMode.
--
-- Safety/reliability concerns:
--
@@ -225,105 +278,123 @@ data FileType = Directory
-- Throws:
--
-- - `NoSuchThing` if source directory does not exist
-- - `PermissionDenied` if output directory is not writable
-- - `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)
-- - `InvalidArgument` if source directory is wrong type (regular file)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `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
-- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
copyDirRecursive :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination
copyDirRecursive :: Path Abs -- ^ copy contents of this source dir
-> Path Abs -- ^ to this full destination (parent dirs
-- are not automatically created)
-> CopyMode
-> RecursiveErrorMode
-> IO ()
copyDirRecursive fromp destdirp
copyDirRecursive fromp destdirp cm rm
= do
ce <- newIORef []
-- for performance, sanity checks are only done for the top dir
throwSameFile fromp destdirp
throwDestinationInSource fromp destdirp
go fromp destdirp
go ce fromp destdirp
collectedExceptions <- readIORef ce
unless (null collectedExceptions)
(throwIO . RecursiveFailure $ collectedExceptions)
where
go :: Path Abs -> Path Abs -> IO ()
go fromp' destdirp' = do
go :: IORef [IOException] -> Path Abs -> Path Abs -> IO ()
go ce fromp' destdirp' = do
-- order is important here, so we don't get empty directories
-- on failure
contents <- getDirsFiles fromp'
contents <- handleIOE ce [] $ do
contents <- getDirsFiles fromp'
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
createDirectory (fromAbs destdirp') fmode'
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
case cm of
Strict -> createDirectory (fromAbs destdirp') fmode'
Overwrite -> catchIOError (createDirectory (fromAbs destdirp')
fmode')
$ \e ->
case ioeGetErrorType e of
AlreadyExists -> setFileMode (fromAbs destdirp')
fmode'
_ -> ioError e
return contents
-- we can't use `easyCopy` here, because we want to call `go`
-- recursively to skip the top-level sanity checks
for_ contents $ \f -> do
ftype <- getFileType f
newdest <- (destdirp' </>) <$> basename f
case ftype of
SymbolicLink -> recreateSymlink f newdest
Directory -> go f newdest
RegularFile -> copyFile f newdest
SymbolicLink -> handleIOE ce ()
$ recreateSymlink f newdest cm
Directory -> go ce f newdest
RegularFile -> handleIOE ce () $ copyFile f newdest cm
_ -> return ()
handleIOE :: IORef [IOException] -> a -> IO a -> IO a
handleIOE ce def = case rm of
FailEarly -> handleIOError throwIO
CollectFailures -> handleIOError (\e -> modifyIORef ce (e:)
>> return def)
-- |Like `copyDirRecursive` except it overwrites contents of directories
-- if any.
--
-- Throws:
--
-- - `NoSuchThing` if source directory does not exist
-- - `PermissionDenied` if output directory is not writable
-- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source directory is wrong type (symlink)
-- - `InvalidArgument` if source directory is wrong type (regular file)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
copyDirRecursiveOverwrite :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination
-> IO ()
copyDirRecursiveOverwrite fromp destdirp
= do
-- for performance, sanity checks are only done for the top dir
throwSameFile fromp destdirp
throwDestinationInSource fromp destdirp
go fromp destdirp
where
go :: Path Abs -> Path Abs -> IO ()
go fromp' destdirp' = do
-- order is important here, so we don't get empty directories
-- on failure
contents <- getDirsFiles fromp'
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
catchIOError (createDirectory (fromAbs destdirp') fmode') $ \e ->
case ioeGetErrorType e of
AlreadyExists -> setFileMode (fromAbs destdirp') fmode'
_ -> ioError e
for_ contents $ \f -> do
ftype <- getFileType f
newdest <- (destdirp' </>) <$> basename f
case ftype of
SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest)
>> recreateSymlink f newdest
Directory -> go f newdest
RegularFile -> copyFileOverwrite f newdest
_ -> return ()
-- |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 symlink file is wrong type (file)
-- - `InvalidArgument` if symlink file is wrong type (directory)
-- - `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 file already exists
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
--
-- Throws in `Overwrite` mode only:
--
-- - `UnsatisfiedConstraints` if destination file is non-empty directory
--
-- Note: calls `symlink`
recreateSymlink :: Path Abs -- ^ the old symlink file
-> Path Abs -- ^ destination file
-> CopyMode
-> IO ()
recreateSymlink symsource newsym
recreateSymlink symsource newsym cm
= do
throwSameFile symsource newsym
sympoint <- readSymbolicLink (fromAbs symsource)
case cm of
Strict -> return ()
Overwrite -> do
writable <- isWritable (dirname newsym)
isfile <- doesFileExist newsym
isdir <- doesDirectoryExist newsym
when (writable && isfile) (deleteFile newsym)
when (writable && isdir) (deleteDir newsym)
createSymbolicLink sympoint (fromAbs newsym)
@@ -331,64 +402,62 @@ recreateSymlink symsource newsym
-- Neither follows symbolic links, nor accepts them.
-- For "copying" symbolic links, use `recreateSymlink` instead.
--
-- Throws:
-- 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.
--
-- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory is not writable
-- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source file is wrong type (symlink)
-- - `InvalidArgument` if source file is wrong type (directory)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `AlreadyExists` if destination already exists
--
-- Note: calls `sendfile`
copyFile :: Path Abs -- ^ source file
-> Path Abs -- ^ destination file
-> IO ()
copyFile from to = do
throwSameFile from to
_copyFile [SPDF.oNofollow]
[SPDF.oNofollow, SPDF.oExcl]
from to
-- |Like `copyFile` except it overwrites the destination if it already
-- exists.
-- This also works if source and destination are the same file.
-- In `Overwrite` copy mode only overwrites actual files, not directories.
--
-- Safety/reliability concerns:
--
-- * not atomic
-- * falls back to delete-copy method with explicit checks
-- * `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)
-- - `InvalidArgument` if source file is wrong type (directory)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `InvalidArgument` if source file is wrong type (symlink or directory)
-- - `SameFile` if source and destination are the same file
-- (`HPathIOException`)
--
-- Note: calls `sendfile`
copyFileOverwrite :: Path Abs -- ^ source file
-> Path Abs -- ^ destination file
-> IO ()
copyFileOverwrite from to = do
-- Throws in `Strict` mode only:
--
-- - `AlreadyExists` if destination already exists
--
-- Note: calls `sendfile` and possibly `read`/`write` as fallback
copyFile :: Path Abs -- ^ source file
-> Path Abs -- ^ destination file
-> CopyMode
-> IO ()
copyFile from to cm = do
throwSameFile from to
catchIOError (_copyFile [SPDF.oNofollow]
[SPDF.oNofollow, SPDF.oTrunc]
from to) $ \e ->
case ioeGetErrorType e of
-- if the destination file is not writable, we need to
-- figure out if we can still copy by deleting it first
PermissionDenied -> do
exists <- doesFileExist to
writable <- isWritable (dirname to)
if exists && writable
then deleteFile to >> copyFile from to
else ioError e
_ -> ioError e
case cm of
Strict -> _copyFile [SPDF.oNofollow]
[SPDF.oNofollow, SPDF.oExcl]
from to
Overwrite ->
catchIOError (_copyFile [SPDF.oNofollow]
[SPDF.oNofollow, SPDF.oTrunc]
from to) $ \e ->
case ioeGetErrorType e of
-- if the destination file is not writable, we need to
-- figure out if we can still copy by deleting it first
PermissionDenied -> do
exists <- doesFileExist to
writable <- isWritable (dirname to)
if exists && writable
then deleteFile to >> copyFile from to Strict
else ioError e
_ -> ioError e
_copyFile :: [SPDF.Flags]
@@ -398,24 +467,35 @@ _copyFile :: [SPDF.Flags]
-> IO ()
_copyFile sflags dflags from to
=
-- TODO: add sendfile support
void $ readWriteCopy (fromAbs from) (fromAbs to)
-- from sendfile(2) manpage:
-- Applications may wish to fall back to read(2)/write(2) in
-- the case where sendfile() fails with EINVAL or ENOSYS.
withAbsPath to $ \to' -> withAbsPath from $ \from' ->
catchErrno [eINVAL, eNOSYS]
(sendFileCopy from' to')
(void $ readWriteCopy from' to')
where
-- low-level copy operation utilizing read(2)/write(2)
-- in case `sendFileCopy` fails/is unsupported
readWriteCopy :: ByteString -> ByteString -> IO Int
readWriteCopy source dest =
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
copyWith copyAction source dest =
bracket (openFd source SPI.ReadOnly sflags Nothing)
SPI.closeFd
$ \sfd -> do
fileM <- System.Posix.Files.ByteString.fileMode
<$> getFdStatus sfd
bracketeer (SPDT.openFd dest SPI.WriteOnly
bracketeer (openFd dest SPI.WriteOnly
dflags $ Just fileM)
SPI.closeFd
(\fd -> SPI.closeFd fd >> deleteFile to)
$ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->
write' sfd dfd buf 0
$ \dfd -> copyAction sfd dfd
-- this is low-level stuff utilizing sendfile(2) for speed
sendFileCopy :: ByteString -> ByteString -> IO ()
sendFileCopy = copyWith
(\sfd dfd -> sendfileFd dfd sfd EntireFile $ return ())
-- low-level copy operation utilizing read(2)/write(2)
-- in case `sendFileCopy` fails/is unsupported
readWriteCopy :: ByteString -> ByteString -> IO Int
readWriteCopy = copyWith
(\sfd dfd -> allocaBytes (fromIntegral bufSize)
$ \buf -> write' sfd dfd buf 0)
where
bufSize :: CSize
bufSize = 8192
@@ -425,12 +505,14 @@ _copyFile sflags dflags from to
if size == 0
then return $ fromIntegral totalsize
else do rsize <- SPB.fdWriteBuf dfd buf size
when (rsize /= size) (throwIO . CopyFailed $ "wrong size!")
when (rsize /= size) (throwIO . CopyFailed
$ "wrong size!")
write' sfd dfd buf (totalsize + fromIntegral size)
-- |Copies anything. In case of a symlink,
-- it is just recreated, even if it points to a directory.
-- |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:
--
@@ -438,33 +520,18 @@ _copyFile sflags dflags from to
-- * calls `copyDirRecursive` for directories
easyCopy :: Path Abs
-> Path Abs
-> CopyMode
-> RecursiveErrorMode
-> IO ()
easyCopy from to = do
easyCopy from to cm rm = do
ftype <- getFileType from
case ftype of
SymbolicLink -> recreateSymlink from to
RegularFile -> copyFile from to
Directory -> copyDirRecursive from to
SymbolicLink -> recreateSymlink from to cm
RegularFile -> copyFile from to cm
Directory -> copyDirRecursive from to cm rm
_ -> return ()
-- |Like `easyCopy` except it overwrites the destination if it already exists.
-- For directories, this overwrites contents without pruning them, so the resulting
-- directory may have more files than have been copied.
easyCopyOverwrite :: Path Abs
-> Path Abs
-> IO ()
easyCopyOverwrite from to = do
ftype <- getFileType from
case ftype of
SymbolicLink -> whenM (doesFileExist to) (deleteFile to)
>> recreateSymlink from to
RegularFile -> copyFileOverwrite from to
Directory -> copyDirRecursiveOverwrite from to
_ -> return ()
@@ -473,7 +540,7 @@ easyCopyOverwrite from to = do
---------------------
-- |Deletes the given file, does not follow symlinks. Raises `eISDIR`
-- |Deletes the given file. Raises `eISDIR`
-- if run on a directory. Does not follow symbolic links.
--
-- Throws:
@@ -504,6 +571,10 @@ deleteDir p = withAbsPath p removeDirectory
-- 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
@@ -531,9 +602,10 @@ deleteDirRecursive p =
removeDirectory . toFilePath $ p
-- |Deletes a file, directory or symlink, whatever it may be.
-- |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:
--
@@ -582,15 +654,16 @@ executeFile fp args
---------------------
-- |Create an empty regular file at the given directory with the given filename.
-- |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 file already exists
createRegularFile :: Path Abs -> IO ()
createRegularFile dest =
bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just newFilePerms)
createRegularFile :: FileMode -> Path Abs -> IO ()
createRegularFile fm dest =
bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just fm)
(SPI.defaultFileFlags { exclusive = True }))
SPI.closeFd
(\_ -> return ())
@@ -602,10 +675,24 @@ createRegularFile dest =
--
-- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination directory already exists
createDir :: Path Abs -> IO ()
createDir dest = createDirectory (fromAbs dest) newDirPerms
createDir :: FileMode -> Path Abs -> IO ()
createDir fm dest = createDirectory (fromAbs dest) fm
-- |Create a symlink.
--
-- Throws:
--
-- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination file already exists
--
-- Note: calls `symlink`
createSymlink :: Path Abs -- ^ destination file
-> ByteString -- ^ path the symlink points to
-> IO ()
createSymlink dest sympoint
= createSymbolicLink sympoint (fromAbs dest)
----------------------------
@@ -627,10 +714,14 @@ createDir dest = createDirectory (fromAbs dest) newDirPerms
-- - `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
-- - `UnsupportedOperation` if source and destination are on different
-- devices
-- - `FileDoesExist` if destination file already exists
-- (`HPathIOException`)
-- - `DirDoesExist` if destination directory already exists
-- - `SameFile` if destination and source are the same file (`HPathIOException`)
-- (`HPathIOException`)
-- - `SameFile` if destination and source are the same file
-- (`HPathIOException`)
--
-- Note: calls `rename` (but does not allow to rename over existing files)
renameFile :: Path Abs -> Path Abs -> IO ()
@@ -646,66 +737,59 @@ renameFile fromf tof = do
--
-- 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
-- - `FileDoesExist` if destination file already exists
-- - `DirDoesExist` if destination directory already exists
-- - `SameFile` if destination and source are the same file (`HPathIOException`)
-- - `SameFile` if destination and source are the same file
-- (`HPathIOException`)
--
-- Throws in `Strict` mode only:
--
-- - `FileDoesExist` if destination file already exists (`HPathIOException`)
-- - `DirDoesExist` if destination directory already exists
-- (`HPathIOException`)
--
-- Note: calls `rename` (but does not allow to rename over existing files)
moveFile :: Path Abs -- ^ file to move
-> Path Abs -- ^ destination
-> CopyMode
-> IO ()
moveFile from to = do
moveFile from to cm = do
throwSameFile from to
catchErrno [eXDEV] (renameFile from to) $ do
easyCopy from to
easyDelete from
case cm of
Strict -> catchErrno [eXDEV] (renameFile from to) $ do
easyCopy from to Strict FailEarly
easyDelete from
Overwrite -> do
ft <- getFileType from
writable <- isWritable $ dirname to
case ft of
RegularFile -> do
exists <- doesFileExist to
when (exists && writable) (deleteFile to)
SymbolicLink -> do
exists <- doesFileExist to
when (exists && writable) (deleteFile to)
Directory -> do
exists <- doesDirectoryExist to
when (exists && writable) (deleteDir to)
_ -> return ()
moveFile from to Strict
-- |Like `moveFile`, but overwrites the destination if it exists.
--
-- Does not follow symbolic links, but renames the symbolic link file.
--
-- Safety/reliability concerns:
--
-- * copy-delete fallback is inherently non-atomic
-- * checks for file types and destination file existence explicitly
--
-- 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`)
--
-- Note: calls `rename` (but does not allow to rename over existing files)
moveFileOverwrite :: Path Abs -- ^ file to move
-> Path Abs -- ^ destination
-> IO ()
moveFileOverwrite from to = do
throwSameFile from to
ft <- getFileType from
writable <- isWritable $ dirname to
case ft of
RegularFile -> do
exists <- doesFileExist to
when (exists && writable) (deleteFile to)
SymbolicLink -> do
exists <- doesFileExist to
when (exists && writable) (deleteFile to)
Directory -> do
exists <- doesDirectoryExist to
when (exists && writable) (deleteDir to)
_ -> return ()
moveFile from to
@@ -745,6 +829,8 @@ newDirPerms
-- |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
@@ -755,14 +841,12 @@ newDirPerms
getDirsFiles :: Path Abs -- ^ dir to read
-> IO [Path Abs]
getDirsFiles p =
withAbsPath p $ \fp ->
bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing)
SPI.closeFd
$ \fd ->
return
. catMaybes
. fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
=<< getDirectoryContents' fd
withAbsPath p $ \fp -> do
fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
return
. catMaybes
. fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
=<< getDirectoryContents' fd
where
parseMaybe :: ByteString -> Maybe (Path Fn)
parseMaybe = parseFn

View File

@@ -1,7 +1,7 @@
-- |
-- Module : HPath.IO.Errors
-- Copyright : © 2016 Julian Ospald
-- License : GPL-2
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
@@ -27,6 +27,7 @@ module HPath.IO.Errors
, isInvalidOperation
, isCan'tOpenDirectory
, isCopyFailed
, isRecursiveFailure
-- * Path based functions
, throwFileDoesExist
@@ -66,9 +67,9 @@ import Data.ByteString
(
ByteString
)
import Data.Data
import Data.ByteString.UTF8
(
Data(..)
toString
)
import Data.Typeable
import Foreign.C.Error
@@ -110,25 +111,42 @@ data HPathIOException = FileDoesNotExist ByteString
| InvalidOperation String
| Can'tOpenDirectory ByteString
| CopyFailed String
deriving (Typeable, Eq, Data)
| RecursiveFailure [IOException]
deriving (Typeable, Eq)
instance Show HPathIOException where
show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp
show (FileDoesNotExist fp) = "File does not exist:" ++ toString fp
show (DirDoesNotExist fp) = "Directory does not exist: "
++ fpToString fp
show (SameFile fp1 fp2) = fpToString fp1
++ " and " ++ fpToString fp2
++ toString fp
show (SameFile fp1 fp2) = toString fp1
++ " and " ++ toString fp2
++ " are the same file!"
show (DestinationInSource fp1 fp2) = fpToString fp1
show (DestinationInSource fp1 fp2) = toString fp1
++ " is contained in "
++ fpToString fp2
show (FileDoesExist fp) = "File does exist: " ++ fpToString fp
show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp
++ toString fp2
show (FileDoesExist fp) = "File does exist: " ++ toString fp
show (DirDoesExist fp) = "Directory does exist: " ++ toString fp
show (InvalidOperation str) = "Invalid operation: " ++ str
show (Can'tOpenDirectory fp) = "Can't open directory: "
++ fpToString fp
++ toString fp
show (CopyFailed str) = "Copying failed: " ++ str
show (RecursiveFailure exs) = "Recursive operation failed: "
++ show exs
toConstr :: HPathIOException -> String
toConstr FileDoesNotExist {} = "FileDoesNotExist"
toConstr DirDoesNotExist {} = "DirDoesNotExist"
toConstr SameFile {} = "SameFile"
toConstr DestinationInSource {} = "DestinationInSource"
toConstr FileDoesExist {} = "FileDoesExist"
toConstr DirDoesExist {} = "DirDoesExist"
toConstr InvalidOperation {} = "InvalidOperation"
toConstr Can'tOpenDirectory {} = "Can'tOpenDirectory"
toConstr CopyFailed {} = "CopyFailed"
toConstr RecursiveFailure {} = "RecursiveFailure"
@@ -142,7 +160,7 @@ instance Exception HPathIOException
--[ Exception identifiers ]--
-----------------------------
isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed :: HPathIOException -> Bool
isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed, isRecursiveFailure :: HPathIOException -> Bool
isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{}
isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{}
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{}
@@ -152,7 +170,7 @@ isDirDoesExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesExist{}
isInvalidOperation ex = toConstr (ex :: HPathIOException) == toConstr InvalidOperation{}
isCan'tOpenDirectory ex = toConstr (ex :: HPathIOException) == toConstr Can'tOpenDirectory{}
isCopyFailed ex = toConstr (ex :: HPathIOException) == toConstr CopyFailed{}
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{}
@@ -209,12 +227,13 @@ sameFile fp1 fp2 =
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 :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination, `dirname dest`
-> Path Abs -- ^ full destination, @dirname dest@
-- must exist
-> IO ()
throwDestinationInSource source dest = do
@@ -266,7 +285,7 @@ canOpenDirectory fp =
return True
-- |Throws a `Can'tOpenDirectory` FmIOException if the directory at the given
-- |Throws a `Can'tOpenDirectory` HPathIOException if the directory at the given
-- path cannot be opened.
throwCantOpenDirectory :: Path Abs -> IO ()
throwCantOpenDirectory fp =
@@ -332,8 +351,8 @@ bracketeer before after afterEx thing =
reactOnError :: IO a
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors
-> [(HPathIOException, IO a)] -- ^ reaction on FmIOException
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors
-> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException
-> IO a
reactOnError a ios fmios =
a `catches` [iohandler, fmiohandler]

View File

@@ -1,7 +1,7 @@
-- |
-- Module : HPath.IO.Utils
-- Copyright : © 2016 Julian Ospald
-- License : GPL-2
-- License : BSD3
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental

View File

@@ -3,8 +3,7 @@
-- | Internal types and functions.
module HPath.Internal
(Path(..)
,RelC)
(Path(..))
where
import Control.DeepSeq (NFData (..))
@@ -13,7 +12,7 @@ import Data.Data
-- | Path of some base and type.
--
-- Internally is a string. The string can be of two formats only:
-- Internally is a ByteString. The ByteString can be of two formats only:
--
-- 1. without trailing path separator: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@
-- 2. with trailing path separator: @foo\/@, @\/foo\/bar\/@
@@ -23,7 +22,7 @@ import Data.Data
data Path b = MkPath ByteString
deriving (Typeable)
-- | String equality.
-- | ByteString equality.
--
-- The following property holds:
--
@@ -31,7 +30,7 @@ data Path b = MkPath ByteString
instance Eq (Path b) where
(==) (MkPath x) (MkPath y) = x == y
-- | String ordering.
-- | ByteString ordering.
--
-- The following property holds:
--
@@ -39,7 +38,7 @@ instance Eq (Path b) where
instance Ord (Path b) where
compare (MkPath x) (MkPath y) = compare x y
-- | Same as 'Path.toFilePath'.
-- | Same as 'HPath.toFilePath'.
--
-- The following property holds:
--
@@ -50,6 +49,3 @@ instance Show (Path b) where
instance NFData (Path b) where
rnf (MkPath x) = rnf x
class RelC m

View File

@@ -1,9 +1,25 @@
-- |
-- Module : System.Posix.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 CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-}
module System.Posix.Directory.Traversals (
getDirectoryContents
@@ -17,12 +33,15 @@ module System.Posix.Directory.Traversals (
, readDirEnt
, packDirStream
, unpackDirStream
, openFd
, fdOpendir
, realpath
) where
import Control.Applicative
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad
import System.Posix.FilePath ((</>))
import System.Posix.Directory.Foreign
@@ -36,6 +55,7 @@ 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
@@ -54,6 +74,8 @@ import Foreign.Storable
-- 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
@@ -71,6 +93,8 @@ allDirectoryContents topdir = do
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
@@ -80,6 +104,8 @@ allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:
-- 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
@@ -103,17 +129,17 @@ actOnDirContents :: RawFilePath
-> IO b
actOnDirContents pathRelToTop b f =
modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .
(`ioeSetLocation` "findBSTypRel")) $ do
(`ioeSetLocation` "findBSTypRel")) $
bracket
(openDirStream pathRelToTop)
(Posix.closeDirStream)
Posix.closeDirStream
(\dirp -> loop dirp b)
where
loop dirp b' = do
(typ,e) <- readDirEnt dirp
if (e == "")
then return b'
else do
else
if (e == "." || e == "..")
then loop dirp b'
else f typ (pathRelToTop </> e) b' >>= loop dirp
@@ -154,9 +180,6 @@ foreign import ccall "realpath"
foreign import ccall unsafe "fdopendir"
c_fdopendir :: Posix.Fd -> IO (Ptr ())
foreign import ccall unsafe "open"
c_open :: CString -> CInt -> Posix.CMode -> IO CInt
----------------------------------------------------------
-- less dodgy but still lower-level
@@ -189,81 +212,53 @@ readDirEnt (unpackDirStream -> dirp) =
else throwErrno "readDirEnt"
-- |Gets all directory contents (not recursively).
getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]
getDirectoryContents path =
modifyIOError ((`ioeSetFileName` (BS.unpack path)) .
(`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ do
(`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $
bracket
(PosixBS.openDirStream path)
PosixBS.closeDirStream
loop
where
loop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- loop dirp
return (t:es)
_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 =
bracket
(fdOpendir fd)
PosixBS.closeDirStream
loop
where
loop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- loop dirp
return (t:es)
getDirectoryContents' fd = do
dirstream <- fdOpendir fd `catchIOError` \e -> do
closeFd fd
ioError e
-- closeDirStream closes the filedescriptor
finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream)
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.
openFd :: RawFilePath
-> Posix.OpenMode
-> [Flags]
-> Maybe Posix.FileMode
-> IO Posix.Fd
openFd name how optional_flags maybe_mode =
withFilePath name $ \str ->
throwErrnoPathIfMinus1Retry "openFd" name $
open_ str how optional_flags maybe_mode
_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)
-- like canonicalizePath, but uses @realpath(3)@
realpath :: RawFilePath -> IO RawFilePath
realpath inp = do
realpath inp =
allocaBytes pathMax $ \tmp -> do
void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp
BS.packCString tmp

75
src/System/Posix/FD.hs Normal file
View File

@@ -0,0 +1,75 @@
-- |
-- 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.Directory.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

@@ -11,6 +11,8 @@
--
-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-}
@@ -18,7 +20,7 @@
module System.Posix.FilePath (
-- * Separators
-- * Separator predicates
pathSeparator
, isPathSeparator
, searchPathSeparator
@@ -26,7 +28,11 @@ module System.Posix.FilePath (
, extSeparator
, isExtSeparator
-- * File extensions
-- * $PATH methods
, splitSearchPath
, getSearchPath
-- * Extension functions
, splitExtension
, takeExtension
, replaceExtension
@@ -37,8 +43,9 @@ module System.Posix.FilePath (
, splitExtensions
, dropExtensions
, takeExtensions
, stripExtension
-- * Filenames/Directory names
-- * Filename\/directory functions
, splitFileName
, takeFileName
, replaceFileName
@@ -47,92 +54,135 @@ module System.Posix.FilePath (
, replaceBaseName
, takeDirectory
, replaceDirectory
-- * Path combinators and splitters
, combine
, (</>)
, splitPath
, joinPath
, splitDirectories
-- * Path conversions
, normalise
-- * Trailing path separator
-- * Trailing slash functions
, hasTrailingPathSeparator
, addTrailingPathSeparator
, dropTrailingPathSeparator
-- * Queries
-- * File name manipulations
, normalise
, makeRelative
, equalFilePath
, isRelative
, isAbsolute
, isValid
, makeValid
, isFileName
, hasParentDir
, equalFilePath
, hiddenFile
-- * Type conversion
, fpToString
, userStringToFP
, module System.Posix.ByteString.FilePath
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (fromString, toString)
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 Test.QuickCheck
-- >>> import Control.Applicative
-- >>> import qualified Data.ByteString as BS
-- >>> import Data.ByteString (ByteString)
-- >>> 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)
------------------------
-- extension stuff
-- $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
--
@@ -152,6 +202,7 @@ splitExtension x = if BS.null basename
(path,file) = splitFileNameRaw x
(basename,fileExt) = BS.breakEnd isExtSeparator file
-- | Get the final extension from a 'RawFilePath'
--
-- >>> takeExtension "file.exe"
@@ -163,12 +214,14 @@ splitExtension x = if BS.null basename
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"
@@ -180,6 +233,7 @@ replaceExtension path ext = dropExtension path <.> ext
dropExtension :: RawFilePath -> RawFilePath
dropExtension = fst . splitExtension
-- | Add an extension to a 'RawFilePath'
--
-- >>> addExtension "file" ".exe"
@@ -195,10 +249,6 @@ addExtension file ext
| otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext]
-- | Operator version of 'addExtension'
(<.>) :: RawFilePath -> ByteString -> RawFilePath
(<.>) = addExtension
-- | Check if a 'RawFilePath' has an extension
--
-- >>> hasExtension "file"
@@ -210,7 +260,13 @@ addExtension file ext
hasExtension :: RawFilePath -> Bool
hasExtension = isJust . BS.elemIndex extSeparator . takeFileName
-- | Split a 'RawFilePath' on the first extension
-- | Operator version of 'addExtension'
(<.>) :: RawFilePath -> ByteString -> RawFilePath
(<.>) = addExtension
-- | Split a 'RawFilePath' on the first extension.
--
-- >>> splitExtensions "/path/file.tar.gz"
-- ("/path/file",".tar.gz")
@@ -224,6 +280,7 @@ splitExtensions x = if BS.null basename
(path,file) = splitFileNameRaw x
(basename,fileExt) = BS.break isExtSeparator file
-- | Remove all extensions from a 'RawFilePath'
--
-- >>> dropExtensions "/path/file.tar.gz"
@@ -231,6 +288,7 @@ splitExtensions x = if BS.null basename
dropExtensions :: RawFilePath -> RawFilePath
dropExtensions = fst . splitExtensions
-- | Take all extensions from a 'RawFilePath'
--
-- >>> takeExtensions "/path/file.tar.gz"
@@ -238,8 +296,48 @@ dropExtensions = fst . splitExtensions
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
------------------------
-- more stuff
-- Filename/directory functions
-- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse
--
@@ -269,12 +367,14 @@ splitFileName x = if BS.null 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"
@@ -284,6 +384,7 @@ replaceFileName x y = fst (splitFileNameRaw x) </> y
dropFileName :: RawFilePath -> RawFilePath
dropFileName = fst . splitFileName
-- | Get the file name, without a trailing extension
--
-- >>> takeBaseName "path/file.tar.gz"
@@ -293,6 +394,7 @@ dropFileName = fst . splitFileName
takeBaseName :: RawFilePath -> ByteString
takeBaseName = dropExtension . takeFileName
-- | Change the base name
--
-- >>> replaceBaseName "path/file.tar.gz" "bob"
@@ -305,6 +407,7 @@ replaceBaseName path name = combineRaw dir (name <.> ext)
(dir,file) = splitFileNameRaw path
ext = takeExtension file
-- | Get the directory, moving up one level if it's already a directory
--
-- >>> takeDirectory "path/file.txt"
@@ -324,12 +427,14 @@ takeDirectory x = case () of
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"
@@ -342,6 +447,7 @@ 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
@@ -363,6 +469,17 @@ splitPath = splitter
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"
@@ -378,14 +495,60 @@ splitDirectories x
where
splitter = filter (not . BS.null) . BS.split pathSeparator
-- | Join a split path back together
------------------------
-- Trailing slash functions
-- | Check if the last character of a 'RawFilePath' is '/'.
--
-- prop> \path -> joinPath (splitPath path) == path
-- >>> 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.
--
-- >>> joinPath ["path","to","file.txt"]
-- "path/to/file.txt"
joinPath :: [RawFilePath] -> RawFilePath
joinPath = foldr (</>) BS.empty
-- >>> 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.
@@ -442,139 +605,47 @@ normalise filepath =
dropDots = filter (BS.singleton _period /=)
------------------------
-- trailing path separators
-- | Check if the last character of a 'RawFilePath' is '/'.
-- | 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>.
--
-- >>> 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.
-- >>> 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"
--
-- >>> 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
------------------------
-- Filename/system stuff
-- | 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
-- | Check if a path is relative
--
-- prop> \path -> isRelative path /= isAbsolute path
isRelative :: RawFilePath -> Bool
isRelative = not . isAbsolute
-- | 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
-- | Is the given filename a valid filename?
--
-- >>> isFileName "lal"
-- True
-- >>> isFileName "."
-- True
-- >>> isFileName ".."
-- True
-- >>> isFileName ""
-- False
-- >>> isFileName "\0"
-- False
-- >>> isFileName "/random_ path:*"
-- False
isFileName :: ByteString -> Bool
isFileName filepath =
not (BS.singleton pathSeparator `BS.isInfixOf` filepath) &&
not (BS.null filepath) &&
not (_nul `BS.elem` filepath)
-- | Helper function: 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 :: ByteString -> 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
)
-- 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
pathDoubleDot = BS.pack [_period, _period]
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.
@@ -585,6 +656,8 @@ hasParentDir filepath =
-- True
-- >>> equalFilePath "foo" "./foo"
-- True
-- >>> equalFilePath "" ""
-- True
-- >>> equalFilePath "foo" "/foo"
-- False
-- >>> equalFilePath "foo" "FOO"
@@ -599,37 +672,138 @@ equalFilePath p1 p2 = f p1 == f p2
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
-- | 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"
-- False
-- >>> hiddenFile "dod.bar"
-- False
-- >>> hiddenFile "."
-- False
-- >>> hiddenFile ".."
-- False
-- >>> hiddenFile ""
-- False
hiddenFile :: RawFilePath -> Bool
hiddenFile fp
| fp == BS.pack [_period, _period] = False
| fp == BS.pack [_period] = False
| fn == BS.pack [_period, _period] = False
| fn == BS.pack [_period] = False
| otherwise = BS.pack [extSeparator]
`BS.isPrefixOf` fp
`BS.isPrefixOf` fn
where
fn = takeFileName fp
------------------------
-- conversion
-- |Uses UTF-8 decoding to convert the bytestring into a String.
fpToString :: ByteString -> String
fpToString = toString
-- |Uses UTF-8 encoding to convert a user provided String into
-- a ByteString, which represents a filepath.
userStringToFP :: String -> ByteString
userStringToFP = fromString
------------------------
@@ -638,7 +812,7 @@ userStringToFP = fromString
-- Just split the input FileName without adding/normalizing or changing
-- anything.
splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw x = BS.breakEnd isPathSeparator x
splitFileNameRaw = BS.breakEnd isPathSeparator
-- | Combine two paths, assuming rhs is NOT absolute.
combineRaw :: RawFilePath -> RawFilePath -> RawFilePath

View File

@@ -13,54 +13,66 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/canonicalizePathSpec/"
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.canonicalizePath" $ do
-- successes --
it "canonicalizePath, all fine" $ do
path <- withPwd (specDir `ba` "file") return
canonicalizePath' (specDir `ba` "file")
path <- withTmpDir "file" return
canonicalizePath' "file"
`shouldReturn` path
it "canonicalizePath, all fine" $ do
path <- withPwd (specDir `ba` "dir") return
canonicalizePath' (specDir `ba` "dir")
path <- withTmpDir "dir" return
canonicalizePath' "dir"
`shouldReturn` path
it "canonicalizePath, all fine" $ do
path <- withPwd (specDir `ba` "file") return
canonicalizePath' (specDir `ba` "fileSym")
path <- withTmpDir "file" return
canonicalizePath' "fileSym"
`shouldReturn` path
it "canonicalizePath, all fine" $ do
path <- withPwd (specDir `ba` "dir") return
canonicalizePath' (specDir `ba` "dirSym")
path <- withTmpDir "dir" return
canonicalizePath' "dirSym"
`shouldReturn` path
-- posix failures --
it "canonicalizePath, broken symlink" $
canonicalizePath' (specDir `ba` "brokenSym")
canonicalizePath' "brokenSym"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "canonicalizePath, file does not exist" $
canonicalizePath' (specDir `ba` "nothingBlah")
canonicalizePath' "nothingBlah"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -0,0 +1,245 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyDirRecursiveCollectFailuresSpec where
import Test.Hspec
import Data.List (sort)
import HPath.IO
import HPath.IO.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 "HPath.IO.copyDirRecursive" $ do
-- successes --
it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir"
"outputDir"
Strict
CollectFailures
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir")
`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 (\e -> ioeGetErrorType e == InappropriateType) ex &&
any (\e -> ioeGetErrorType e == PermissionDenied) 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 [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 [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 [e]) -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [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,9 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyDirRecursiveOverwriteSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@@ -16,95 +18,185 @@ import GHC.IO.Exception
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/copyDirRecursiveOverwriteSpec/"
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"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HPath.IO.copyDirRecursiveOverwrite" $ do
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyDirRecursive" $ do
-- successes --
it "copyDirRecursiveOverwrite, all fine" $ do
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "outputDir")
removeDirIfExists $ specDir `ba` "outputDir"
it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do
copyDirRecursive' "inputDir"
"outputDir"
Overwrite
FailEarly
removeDirIfExists "outputDir"
it "copyDirRecursiveOverwrite, all fine and compare" $ do
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "outputDir")
it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir"
"outputDir"
Overwrite
FailEarly
(system $ "diff -r --no-dereference "
++ specDir' ++ "inputDir" ++ " "
++ specDir' ++ "outputDir")
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir")
`shouldReturn` ExitSuccess
removeDirIfExists $ specDir `ba` "outputDir"
removeDirIfExists "outputDir"
it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do
tmpDir' <- getRawTmpDir
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "alreadyExistsD")
`shouldReturn` (ExitFailure 1)
copyDirRecursive' "inputDir"
"alreadyExistsD"
Overwrite
FailEarly
(system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "alreadyExistsD")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
it "copyDirRecursiveOverwrite, destination dir already exists" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "alreadyExistsD")
-- posix failures --
it "copyDirRecursiveOverwrite, source directory does not exist" $
copyDirRecursiveOverwrite' (specDir `ba` "doesNotExist")
(specDir `ba` "outputDir")
it "copyDirRecursive, source directory does not exist" $
copyDirRecursive' "doesNotExist"
"outputDir"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursiveOverwrite, no write permission on output dir" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "noWritePerm/foo")
it "copyDirRecursive, no write permission on output dir" $
copyDirRecursive' "inputDir"
"noWritePerm/foo"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, cannot open output dir" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "noPerms/foo")
it "copyDirRecursive, cannot open output dir" $
copyDirRecursive' "inputDir"
"noPerms/foo"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, cannot open source dir" $
copyDirRecursiveOverwrite' (specDir `ba` "noPerms/inputDir")
(specDir `ba` "foo")
it "copyDirRecursive, cannot open source dir" $
copyDirRecursive' "noPerms/inputDir"
"foo"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursiveOverwrite, destination already exists and is a file" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "alreadyExists")
it "copyDirRecursive, destination already exists and is a file" $
copyDirRecursive' "inputDir"
"alreadyExists"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursiveOverwrite, wrong input (regular file)" $
copyDirRecursiveOverwrite' (specDir `ba` "wrongInput")
(specDir `ba` "outputDir")
it "copyDirRecursive, wrong input (regular file)" $
copyDirRecursive' "wrongInput"
"outputDir"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $
copyDirRecursiveOverwrite' (specDir `ba` "wrongInputSymL")
(specDir `ba` "outputDir")
it "copyDirRecursive, wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Overwrite
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures
it "copyDirRecursiveOverwrite, destination in source" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "inputDir/foo")
it "copyDirRecursive (Overwrite, FailEarly), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Overwrite
FailEarly
`shouldThrow`
isDestinationInSource
it "copyDirRecursiveOverwrite, destination and source same directory" $
copyDirRecursiveOverwrite' (specDir `ba` "inputDir")
(specDir `ba` "inputDir")
it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Overwrite
FailEarly
`shouldThrow`
isSameFile

View File

@@ -1,9 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyDirRecursiveSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@@ -16,97 +18,163 @@ import GHC.IO.Exception
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/copyDirRecursiveSpec/"
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"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyDirRecursive" $ do
-- successes --
it "copyDirRecursive, all fine" $ do
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "outputDir")
removeDirIfExists (specDir `ba` "outputDir")
it "copyDirRecursive (Strict, FailEarly), all fine" $ do
copyDirRecursive' "inputDir"
"outputDir"
Strict
FailEarly
removeDirIfExists "outputDir"
it "copyDirRecursive, all fine and compare" $ do
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "outputDir")
it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir"
"outputDir"
Strict
FailEarly
(system $ "diff -r --no-dereference "
++ specDir' ++ "inputDir" ++ " "
++ specDir' ++ "outputDir")
++ toString tmpDir' ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir")
`shouldReturn` ExitSuccess
removeDirIfExists (specDir `ba` "outputDir")
removeDirIfExists "outputDir"
-- posix failures --
it "copyDirRecursive, source directory does not exist" $
copyDirRecursive' (specDir `ba` "doesNotExist")
(specDir `ba` "outputDir")
it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $
copyDirRecursive' "doesNotExist"
"outputDir"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive, no write permission on output dir" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "noWritePerm/foo")
it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $
copyDirRecursive' "inputDir"
"noWritePerm/foo"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open output dir" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "noPerms/foo")
it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $
copyDirRecursive' "inputDir"
"noPerms/foo"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open source dir" $
copyDirRecursive' (specDir `ba` "noPerms/inputDir")
(specDir `ba` "foo")
it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $
copyDirRecursive' "noPerms/inputDir"
"foo"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, destination dir already exists" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "alreadyExistsD")
it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $
copyDirRecursive' "inputDir"
"alreadyExistsD"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive, destination already exists and is a file" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "alreadyExists")
it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $
copyDirRecursive' "inputDir"
"alreadyExists"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive, wrong input (regular file)" $
copyDirRecursive' (specDir `ba` "wrongInput")
(specDir `ba` "outputDir")
it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $
copyDirRecursive' "wrongInput"
"outputDir"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive, wrong input (symlink to directory)" $
copyDirRecursive' (specDir `ba` "wrongInputSymL")
(specDir `ba` "outputDir")
it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Strict
FailEarly
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures
it "copyDirRecursive, destination in source" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "inputDir/foo")
it "copyDirRecursive (Strict, FailEarly), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Strict
FailEarly
`shouldThrow`
isDestinationInSource
it "copyDirRecursive, destination and source same directory" $
copyDirRecursive' (specDir `ba` "inputDir")
(specDir `ba` "inputDir")
it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Strict
FailEarly
`shouldThrow`
isSameFile

View File

@@ -4,6 +4,7 @@ module HPath.IO.CopyFileOverwriteSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@@ -16,94 +17,132 @@ import GHC.IO.Exception
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/copyFileOverwriteSpec/"
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileOverwriteSpec"
createTmpDir
specDir' :: String
specDir' = toString specDir
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 =
describe "HPath.IO.copyFileOverwrite" $ do
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyFile" $ do
-- successes --
it "copyFileOverwrite, everything clear" $ do
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "outputFile")
removeFileIfExists (specDir `ba` "outputFile")
it "copyFile (Overwrite), everything clear" $ do
copyFile' "inputFile"
"outputFile"
Overwrite
removeFileIfExists "outputFile"
it "copyFileOverwrite, output file already exists, all clear" $ do
copyFile' (specDir `ba` "alreadyExists") (specDir `ba` "alreadyExists.bak")
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "alreadyExists")
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
++ specDir' ++ "alreadyExists")
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 (specDir `ba` "alreadyExists")
copyFile' (specDir `ba` "alreadyExists.bak") (specDir `ba` "alreadyExists")
removeFileIfExists (specDir `ba` "alreadyExists.bak")
removeFileIfExists "alreadyExists"
copyFile' "alreadyExists.bak" "alreadyExists" Strict
removeFileIfExists "alreadyExists.bak"
it "copyFileOverwrite, and compare" $ do
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "outputFile")
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
++ specDir' ++ "outputFile")
it "copyFile (Overwrite), and compare" $ do
tmpDir' <- getRawTmpDir
copyFile' "inputFile"
"outputFile"
Overwrite
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "
++ toString tmpDir' ++ "outputFile")
`shouldReturn` ExitSuccess
removeFileIfExists (specDir `ba` "outputFile")
removeFileIfExists "outputFile"
-- posix failures --
it "copyFileOverwrite, input file does not exist" $
copyFileOverwrite' (specDir `ba` "noSuchFile")
(specDir `ba` "outputFile")
it "copyFile (Overwrite), input file does not exist" $
copyFile' "noSuchFile"
"outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyFileOverwrite, no permission to write to output directory" $
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "outputDirNoWrite/outputFile")
it "copyFile (Overwrite), no permission to write to output directory" $
copyFile' "inputFile"
"outputDirNoWrite/outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, cannot open output directory" $
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "noPerms/outputFile")
it "copyFile (Overwrite), cannot open output directory" $
copyFile' "inputFile"
"noPerms/outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, cannot open source directory" $
copyFileOverwrite' (specDir `ba` "noPerms/inputFile")
(specDir `ba` "outputFile")
it "copyFile (Overwrite), cannot open source directory" $
copyFile' "noPerms/inputFile"
"outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFileOverwrite, wrong input type (symlink)" $
copyFileOverwrite' (specDir `ba` "inputFileSymL")
(specDir `ba` "outputFile")
it "copyFile (Overwrite), wrong input type (symlink)" $
copyFile' "inputFileSymL"
"outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "copyFileOverwrite, wrong input type (directory)" $
copyFileOverwrite' (specDir `ba` "wrongInput")
(specDir `ba` "outputFile")
it "copyFile (Overwrite), wrong input type (directory)" $
copyFile' "wrongInput"
"outputFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyFileOverwrite, output file already exists and is a dir" $
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "alreadyExistsD")
it "copyFile (Overwrite), output file already exists and is a dir" $
copyFile' "inputFile"
"alreadyExistsD"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
-- custom failures --
it "copyFileOverwrite, output and input are same file" $
copyFileOverwrite' (specDir `ba` "inputFile")
(specDir `ba` "inputFile")
it "copyFile (Overwrite), output and input are same file" $
copyFile' "inputFile"
"inputFile"
Overwrite
`shouldThrow` isSameFile

View File

@@ -1,9 +1,11 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyFileSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@@ -16,90 +18,126 @@ import GHC.IO.Exception
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/copyFileSpec/"
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileSpec"
createTmpDir
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.copyFile" $ do
-- successes --
it "copyFile, everything clear" $ do
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "outputFile")
removeFileIfExists (specDir `ba` "outputFile")
it "copyFile (Strict), everything clear" $ do
copyFile' "inputFile"
"outputFile"
Strict
removeFileIfExists "outputFile"
it "copyFile, and compare" $ do
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "outputFile")
(system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "
++ specDir' ++ "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 (specDir `ba` "outputFile")
removeFileIfExists "outputFile"
-- posix failures --
it "copyFile, input file does not exist" $
copyFile' (specDir `ba` "noSuchFile")
(specDir `ba` "outputFile")
it "copyFile (Strict), input file does not exist" $
copyFile' "noSuchFile"
"outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile, no permission to write to output directory" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "outputDirNoWrite/outputFile")
it "copyFile (Strict), no permission to write to output directory" $
copyFile' "inputFile"
"outputDirNoWrite/outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, cannot open output directory" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "noPerms/outputFile")
it "copyFile (Strict), cannot open output directory" $
copyFile' "inputFile"
"noPerms/outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, cannot open source directory" $
copyFile' (specDir `ba` "noPerms/inputFile")
(specDir `ba` "outputFile")
it "copyFile (Strict), cannot open source directory" $
copyFile' "noPerms/inputFile"
"outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile, wrong input type (symlink)" $
copyFile' (specDir `ba` "inputFileSymL")
(specDir `ba` "outputFile")
it "copyFile (Strict), wrong input type (symlink)" $
copyFile' "inputFileSymL"
"outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile, wrong input type (directory)" $
copyFile' (specDir `ba` "wrongInput")
(specDir `ba` "outputFile")
it "copyFile (Strict), wrong input type (directory)" $
copyFile' "wrongInput"
"outputFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "copyFile, output file already exists" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "alreadyExists")
it "copyFile (Strict), output file already exists" $
copyFile' "inputFile"
"alreadyExists"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "copyFile, output file already exists and is a dir" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "alreadyExistsD")
it "copyFile (Strict), output file already exists and is a dir" $
copyFile' "inputFile"
"alreadyExistsD"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures --
it "copyFile, output and input are same file" $
copyFile' (specDir `ba` "inputFile")
(specDir `ba` "inputFile")
it "copyFile (Strict), output and input are same file" $
copyFile' "inputFile"
"inputFile"
Strict
`shouldThrow`
isSameFile

View File

@@ -13,42 +13,55 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/createDirSpec/"
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateDirSpec"
createTmpDir
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.createDir" $ do
-- successes --
it "createDir, all fine" $ do
createDir' (specDir `ba` "newDir")
removeDirIfExists (specDir `ba` "newDir")
createDir' "newDir"
removeDirIfExists "newDir"
-- posix failures --
it "createDir, can't write to output directory" $
createDir' (specDir `ba` "noWritePerms/newDir")
createDir' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDir, can't open output directory" $
createDir' (specDir `ba` "noPerms/newDir")
createDir' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDir, destination directory already exists" $
createDir' (specDir `ba` "alreadyExists")
createDir' "alreadyExists"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)

View File

@@ -13,42 +13,53 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/createRegularFileSpec/"
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateRegularFileSpec"
createTmpDir
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.createRegularFile" $ do
-- successes --
it "createRegularFile, all fine" $ do
createRegularFile' (specDir `ba` "newDir")
removeFileIfExists (specDir `ba` "newDir")
createRegularFile' "newDir"
removeFileIfExists "newDir"
-- posix failures --
it "createRegularFile, can't write to destination directory" $
createRegularFile' (specDir `ba` "noWritePerms/newDir")
createRegularFile' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, can't write to destination directory" $
createRegularFile' (specDir `ba` "noPerms/newDir")
createRegularFile' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createRegularFile, destination file already exists" $
createRegularFile' (specDir `ba` "alreadyExists")
createRegularFile' "alreadyExists"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)

View File

@@ -0,0 +1,66 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.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 "HPath.IO.createSymlink" $ do
-- successes --
it "createSymlink, all fine" $ do
createSymlink' "newSymL" "alreadyExists/"
removeFileIfExists "newSymL"
-- posix failures --
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

@@ -17,80 +17,99 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/deleteDirRecursiveSpec/"
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteDirRecursiveSpec"
createTmpDir
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.deleteDirRecursive" $ do
-- successes --
it "deleteDirRecursive, empty directory, all fine" $ do
createDir' (specDir `ba` "testDir")
deleteDirRecursive' (specDir `ba` "testDir")
getSymbolicLinkStatus (specDir `ba` "testDir")
createDir' "testDir"
deleteDirRecursive' "testDir"
getSymbolicLinkStatus "testDir"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDirRecursive, empty directory with null permissions, all fine" $ do
createDir' (specDir `ba` "noPerms/testDir")
noPerms (specDir `ba` "noPerms/testDir")
deleteDirRecursive' (specDir `ba` "noPerms/testDir")
createDir' "noPerms/testDir"
noPerms "noPerms/testDir"
deleteDirRecursive' "noPerms/testDir"
it "deleteDirRecursive, non-empty directory, all fine" $ do
createDir' (specDir `ba` "nonEmpty")
createDir' (specDir `ba` "nonEmpty/dir1")
createDir' (specDir `ba` "nonEmpty/dir2")
createDir' (specDir `ba` "nonEmpty/dir2/dir3")
createRegularFile' (specDir `ba` "nonEmpty/file1")
createRegularFile' (specDir `ba` "nonEmpty/dir1/file2")
deleteDirRecursive' (specDir `ba` "nonEmpty")
getSymbolicLinkStatus (specDir `ba` "nonEmpty")
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' (specDir `ba` "noPerms/foo")
noPerms (specDir `ba` "noPerms")
(deleteDirRecursive' (specDir `ba` "noPerms/foo")
createDir' "noPerms/foo"
noPerms "noPerms"
(deleteDirRecursive' "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
>> normalDirPerms (specDir `ba` "noPerms")
>> deleteDir' (specDir `ba` "noPerms/foo")
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noPerms"
deleteDir' "noPerms/foo"
it "deleteDirRecursive, can't write to parent directory" $ do
createDir' (specDir `ba` "noWritable/foo")
noWritableDirPerms (specDir `ba` "noWritable")
(deleteDirRecursive' (specDir `ba` "noWritable/foo")
createDir' "noWritable/foo"
noWritableDirPerms "noWritable"
(deleteDirRecursive' "noWritable/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
normalDirPerms (specDir `ba` "noWritable")
deleteDir' (specDir `ba` "noWritable/foo")
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noWritable"
deleteDir' "noWritable/foo"
it "deleteDirRecursive, wrong file type (symlink to directory)" $
deleteDirRecursive' (specDir `ba` "dirSym")
deleteDirRecursive' "dirSym"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, wrong file type (regular file)" $
deleteDirRecursive' (specDir `ba` "file")
deleteDirRecursive' "file"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDirRecursive, directory does not exist" $
deleteDirRecursive' (specDir `ba` "doesNotExist")
deleteDirRecursive' "doesNotExist"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)

View File

@@ -17,78 +17,98 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/deleteDirSpec/"
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.deleteDir" $ do
-- successes --
it "deleteDir, empty directory, all fine" $ do
createDir' (specDir `ba` "testDir")
deleteDir' (specDir `ba` "testDir")
getSymbolicLinkStatus (specDir `ba` "testDir")
createDir' "testDir"
deleteDir' "testDir"
getSymbolicLinkStatus "testDir"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory with null permissions, all fine" $ do
createDir' (specDir `ba` "noPerms/testDir")
noPerms (specDir `ba` "noPerms/testDir")
deleteDir' (specDir `ba` "noPerms/testDir")
getSymbolicLinkStatus (specDir `ba` "testDir")
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' (specDir `ba` "dirSym")
deleteDir' "dirSym"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDir, wrong file type (regular file)" $
deleteDir' (specDir `ba` "file")
deleteDir' "file"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteDir, directory does not exist" $
deleteDir' (specDir `ba` "doesNotExist")
deleteDir' "doesNotExist"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteDir, directory not empty" $
deleteDir' (specDir `ba` "dir")
deleteDir' "dir"
`shouldThrow`
(\e -> ioeGetErrorType e == UnsatisfiedConstraints)
it "deleteDir, can't open parent directory" $ do
createDir' (specDir `ba` "noPerms/foo")
noPerms (specDir `ba` "noPerms")
(deleteDir' (specDir `ba` "noPerms/foo")
createDir' "noPerms/foo"
noPerms "noPerms"
(deleteDir' "noPerms/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
>> normalDirPerms (specDir `ba` "noPerms")
>> deleteDir' (specDir `ba` "noPerms/foo")
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noPerms"
deleteDir' "noPerms/foo"
it "deleteDir, can't write to parent directory, still fine" $ do
createDir' (specDir `ba` "noWritable/foo")
noWritableDirPerms (specDir `ba` "noWritable")
(deleteDir' (specDir `ba` "noWritable/foo")
createDir' "noWritable/foo"
noWritableDirPerms "noWritable"
(deleteDir' "noWritable/foo")
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied))
normalDirPerms (specDir `ba` "noWritable")
deleteDir' (specDir `ba` "noWritable/foo")
(\e -> ioeGetErrorType e == PermissionDenied)
normalDirPerms "noWritable"
deleteDir' "noWritable/foo"

View File

@@ -4,6 +4,7 @@ module HPath.IO.DeleteFileSpec where
import Test.Hspec
import HPath.IO
import System.IO.Error
(
ioeGetErrorType
@@ -17,53 +18,67 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteFileSpec"
createTmpDir
specDir :: BS.ByteString
specDir = "test/HPath/IO/deleteFileSpec/"
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.deleteFile" $ do
-- successes --
it "deleteFile, regular file, all fine" $ do
createRegularFile' (specDir `ba` "testFile")
deleteFile' (specDir `ba` "testFile")
getSymbolicLinkStatus (specDir `ba` "testFile")
createRegularFile' "testFile"
deleteFile' "testFile"
getSymbolicLinkStatus "testFile"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, symlink, all fine" $ do
recreateSymlink' (specDir `ba` "syml")
(specDir `ba` "testFile")
deleteFile' (specDir `ba` "testFile")
getSymbolicLinkStatus (specDir `ba` "testFile")
recreateSymlink' "syml"
"testFile"
Strict
deleteFile' "testFile"
getSymbolicLinkStatus "testFile"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
-- posix failures --
it "deleteFile, wrong file type (directory)" $
deleteFile' (specDir `ba` "dir")
deleteFile' "dir"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "deleteFile, file does not exist" $
deleteFile' (specDir `ba` "doesNotExist")
deleteFile' "doesNotExist"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "deleteFile, can't read directory" $
deleteFile' (specDir `ba` "noPerms/blah")
deleteFile' "noPerms/blah"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -3,87 +3,95 @@
module HPath.IO.GetDirsFilesSpec where
import Control.Applicative
(
(<$>)
)
import Data.List
(
sort
)
import Data.Maybe
(
fromJust
)
import qualified HPath as P
import HPath.IO
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Env.ByteString
(
getEnv
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "GetDirsFilesSpec"
createTmpDir
specDir :: BS.ByteString
specDir = "test/HPath/IO/getDirsFilesSpec/"
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.getDirsFiles" $ do
-- successes --
it "getDirsFiles, all fine" $ do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
expectedFiles <- mapM P.parseRel [(specDir `ba ` ".hidden")
,(specDir `ba ` "Lala")
,(specDir `ba ` "dir")
,(specDir `ba ` "dirsym")
,(specDir `ba ` "file")
,(specDir `ba ` "noPerms")
,(specDir `ba ` "syml")]
(fmap sort $ getDirsFiles' specDir)
`shouldReturn` fmap (pwd P.</>) expectedFiles
it "getDirsFiles, all fine" $
withRawTmpDir $ \p -> do
expectedFiles <- mapM P.parseRel [".hidden"
,"Lala"
,"dir"
,"dirsym"
,"file"
,"noPerms"
,"syml"]
(fmap sort $ getDirsFiles p)
`shouldReturn` fmap (p P.</>) expectedFiles
-- posix failures --
it "getDirsFiles, nonexistent directory" $
getDirsFiles' (specDir `ba ` "nothingHere")
getDirsFiles' "nothingHere"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "getDirsFiles, wrong file type (file)" $
getDirsFiles' (specDir `ba ` "file")
getDirsFiles' "file"
`shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType)
it "getDirsFiles, wrong file type (symlink to file)" $
getDirsFiles' (specDir `ba ` "syml")
getDirsFiles' "syml"
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "getDirsFiles, wrong file type (symlink to dir)" $
getDirsFiles' (specDir `ba ` "dirsym")
getDirsFiles' "dirsym"
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "getDirsFiles, can't open directory" $
getDirsFiles' (specDir `ba ` "noPerms")
getDirsFiles' "noPerms"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -14,57 +14,75 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/getFileTypeSpec/"
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"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.getFileType" $ do
-- successes --
it "getFileType, regular file" $
getFileType' (specDir `ba` "regularfile")
getFileType' "regularfile"
`shouldReturn` RegularFile
it "getFileType, directory" $
getFileType' (specDir `ba` "directory")
getFileType' "directory"
`shouldReturn` Directory
it "getFileType, directory with null permissions" $
getFileType' (specDir `ba` "noPerms")
getFileType' "noPerms"
`shouldReturn` Directory
it "getFileType, symlink to file" $
getFileType' (specDir `ba` "symlink")
getFileType' "symlink"
`shouldReturn` SymbolicLink
it "getFileType, symlink to directory" $
getFileType' (specDir `ba` "symlinkD")
getFileType' "symlinkD"
`shouldReturn` SymbolicLink
it "getFileType, broken symlink" $
getFileType' (specDir `ba` "brokenSymlink")
getFileType' "brokenSymlink"
`shouldReturn` SymbolicLink
-- posix failures --
it "getFileType, file does not exist" $
getFileType' (specDir `ba` "nothingHere")
getFileType' "nothingHere"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "getFileType, can't open directory" $
getFileType' (specDir `ba` "noPerms/forz")
getFileType' "noPerms/forz"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -4,6 +4,7 @@ module HPath.IO.MoveFileOverwriteSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@@ -14,80 +15,112 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/moveFileOverwriteSpec/"
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"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
describe "HPath.IO.moveFileOverwrite" $ do
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.moveFile" $ do
-- successes --
it "moveFileOverwrite, all fine" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "movedFile")
it "moveFile (Overwrite), all fine" $
moveFile' "myFile"
"movedFile"
Overwrite
it "moveFileOverwrite, all fine" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "dir/movedFile")
it "moveFile (Overwrite), all fine" $
moveFile' "myFile"
"dir/movedFile"
Overwrite
it "moveFileOverwrite, all fine on symlink" $
moveFileOverwrite' (specDir `ba` "myFileL")
(specDir `ba` "movedFile")
it "moveFile (Overwrite), all fine on symlink" $
moveFile' "myFileL"
"movedFile"
Overwrite
it "moveFileOverwrite, all fine on directory" $
moveFileOverwrite' (specDir `ba` "dir")
(specDir `ba` "movedFile")
it "moveFile (Overwrite), all fine on directory" $
moveFile' "dir"
"movedFile"
Overwrite
it "moveFileOverwrite, destination file already exists" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "alreadyExists")
it "moveFile (Overwrite), destination file already exists" $
moveFile' "myFile"
"alreadyExists"
Overwrite
-- posix failures --
it "moveFileOverwrite, source file does not exist" $
moveFileOverwrite' (specDir `ba` "fileDoesNotExist")
(specDir `ba` "movedFile")
it "moveFile (Overwrite), source file does not exist" $
moveFile' "fileDoesNotExist"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "moveFileOverwrite, can't write to destination directory" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "noWritePerm/movedFile")
it "moveFile (Overwrite), can't write to destination directory" $
moveFile' "myFile"
"noWritePerm/movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFileOverwrite, can't open destination directory" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "noPerms/movedFile")
it "moveFile (Overwrite), can't open destination directory" $
moveFile' "myFile"
"noPerms/movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFileOverwrite, can't open source directory" $
moveFileOverwrite' (specDir `ba` "noPerms/myFile")
(specDir `ba` "movedFile")
it "moveFile (Overwrite), can't open source directory" $
moveFile' "noPerms/myFile"
"movedFile"
Overwrite
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "moveFileOverwrite, move from file to dir" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "alreadyExistsD")
it "moveFile (Overwrite), move from file to dir" $
moveFile' "myFile"
"alreadyExistsD"
Overwrite
`shouldThrow`
isDirDoesExist
it "moveFileOverwrite, source and dest are same file" $
moveFileOverwrite' (specDir `ba` "myFile")
(specDir `ba` "myFile")
it "moveFile (Overwrite), source and dest are same file" $
moveFile' "myFile"
"myFile"
Overwrite
`shouldThrow`
isSameFile

View File

@@ -4,6 +4,7 @@ module HPath.IO.MoveFileSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@@ -14,82 +15,115 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/moveFileSpec/"
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"
specDir' :: String
specDir' = toString specDir
spec :: Spec
spec =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.moveFile" $ do
-- successes --
it "moveFile, all fine" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "movedFile")
it "moveFile (Strict), all fine" $
moveFile' "myFile"
"movedFile"
Strict
it "moveFile, all fine" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "dir/movedFile")
it "moveFile (Strict), all fine" $
moveFile' "myFile"
"dir/movedFile"
Strict
it "moveFile, all fine on symlink" $
moveFile' (specDir `ba` "myFileL")
(specDir `ba` "movedFile")
it "moveFile (Strict), all fine on symlink" $
moveFile' "myFileL"
"movedFile"
Strict
it "moveFile, all fine on directory" $
moveFile' (specDir `ba` "dir")
(specDir `ba` "movedFile")
it "moveFile (Strict), all fine on directory" $
moveFile' "dir"
"movedFile"
Strict
-- posix failures --
it "moveFile, source file does not exist" $
moveFile' (specDir `ba` "fileDoesNotExist")
(specDir `ba` "movedFile")
it "moveFile (Strict), source file does not exist" $
moveFile' "fileDoesNotExist"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "moveFile, can't write to destination directory" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "noWritePerm/movedFile")
it "moveFile (Strict), can't write to destination directory" $
moveFile' "myFile"
"noWritePerm/movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile, can't open destination directory" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "noPerms/movedFile")
it "moveFile (Strict), can't open destination directory" $
moveFile' "myFile"
"noPerms/movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile, can't open source directory" $
moveFile' (specDir `ba` "noPerms/myFile")
(specDir `ba` "movedFile")
it "moveFile (Strict), can't open source directory" $
moveFile' "noPerms/myFile"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "moveFile, destination file already exists" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "alreadyExists")
it "moveFile (Strict), destination file already exists" $
moveFile' "myFile"
"alreadyExists"
Strict
`shouldThrow`
isFileDoesExist
it "moveFile, move from file to dir" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "alreadyExistsD")
it "moveFile (Strict), move from file to dir" $
moveFile' "myFile"
"alreadyExistsD"
Strict
`shouldThrow`
isDirDoesExist
it "moveFile, source and dest are same file" $
moveFile' (specDir `ba` "myFile")
(specDir `ba` "myFile")
it "moveFile (Strict), source and dest are same file" $
moveFile' "myFile"
"myFile"
Strict
`shouldThrow`
isSameFile

View File

@@ -0,0 +1,139 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.RecreateSymlinkOverwriteSpec where
-- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode
import Test.Hspec
import HPath.IO
import HPath.IO.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 "HPath.IO.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

@@ -3,7 +3,10 @@
module HPath.IO.RecreateSymlinkSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@@ -14,82 +17,114 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/recreateSymlinkSpec/"
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RecreateSymlinkSpec"
createTmpDir
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.recreateSymlink" $ do
-- successes --
it "recreateSymLink, all fine" $ do
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "movedFile")
removeFileIfExists (specDir `ba` "movedFile")
it "recreateSymLink (Strict), all fine" $ do
recreateSymlink' "myFileL"
"movedFile"
Strict
removeFileIfExists "movedFile"
it "recreateSymLink, all fine" $ do
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "dir/movedFile")
removeFileIfExists (specDir `ba` "dir/movedFile")
it "recreateSymLink (Strict), all fine" $ do
recreateSymlink' "myFileL"
"dir/movedFile"
Strict
removeFileIfExists "dir/movedFile"
-- posix failures --
it "recreateSymLink, wrong input type (file)" $
recreateSymlink' (specDir `ba` "myFile")
(specDir `ba` "movedFile")
it "recreateSymLink (Strict), wrong input type (file)" $
recreateSymlink' "myFile"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink, wrong input type (directory)" $
recreateSymlink' (specDir `ba` "dir")
(specDir `ba` "movedFile")
it "recreateSymLink (Strict), wrong input type (directory)" $
recreateSymlink' "dir"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink, can't write to destination directory" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "noWritePerm/movedFile")
it "recreateSymLink (Strict), can't write to destination directory" $
recreateSymlink' "myFileL"
"noWritePerm/movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, can't open destination directory" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "noPerms/movedFile")
it "recreateSymLink (Strict), can't open destination directory" $
recreateSymlink' "myFileL"
"noPerms/movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, can't open source directory" $
recreateSymlink' (specDir `ba` "noPerms/myFileL")
(specDir `ba` "movedFile")
it "recreateSymLink (Strict), can't open source directory" $
recreateSymlink' "noPerms/myFileL"
"movedFile"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink, destination file already exists" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "alreadyExists")
it "recreateSymLink (Strict), destination file already exists" $
recreateSymlink' "myFileL"
"alreadyExists"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "recreateSymLink, destination already exists and is a dir" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "alreadyExistsD")
it "recreateSymLink (Strict), destination already exists and is a dir" $
recreateSymlink' "myFileL"
"alreadyExistsD"
Strict
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures --
it "recreateSymLink, source and destination are the same file" $
recreateSymlink' (specDir `ba` "myFileL")
(specDir `ba` "myFileL")
it "recreateSymLink (Strict), source and destination are the same file" $
recreateSymlink' "myFileL"
"myFileL"
Strict
`shouldThrow`
isSameFile

View File

@@ -14,82 +14,104 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
ba :: BS.ByteString -> BS.ByteString -> BS.ByteString
ba = BS.append
specDir :: BS.ByteString
specDir = "test/HPath/IO/renameFileSpec/"
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RenameFileSpec"
createTmpDir
specDir' :: String
specDir' = toString specDir
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 =
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.renameFile" $ do
-- successes --
it "renameFile, all fine" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "renamedFile")
renameFile' "myFile"
"renamedFile"
it "renameFile, all fine" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "dir/renamedFile")
renameFile' "myFile"
"dir/renamedFile"
it "renameFile, all fine on symlink" $
renameFile' (specDir `ba` "myFileL")
(specDir `ba` "renamedFile")
renameFile' "myFileL"
"renamedFile"
it "renameFile, all fine on directory" $
renameFile' (specDir `ba` "dir")
(specDir `ba` "renamedFile")
renameFile' "dir"
"renamedFile"
-- posix failures --
it "renameFile, source file does not exist" $
renameFile' (specDir `ba` "fileDoesNotExist")
(specDir `ba` "renamedFile")
renameFile' "fileDoesNotExist"
"renamedFile"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "renameFile, can't write to output directory" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "noWritePerm/renamedFile")
renameFile' "myFile"
"noWritePerm/renamedFile"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "renameFile, can't open output directory" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "noPerms/renamedFile")
renameFile' "myFile"
"noPerms/renamedFile"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "renameFile, can't open source directory" $
renameFile' (specDir `ba` "noPerms/myFile")
(specDir `ba` "renamedFile")
renameFile' "noPerms/myFile"
"renamedFile"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures --
it "renameFile, destination file already exists" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "alreadyExists")
renameFile' "myFile"
"alreadyExists"
`shouldThrow`
isFileDoesExist
it "renameFile, move from file to dir" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "alreadyExistsD")
renameFile' "myFile"
"alreadyExistsD"
`shouldThrow`
isDirDoesExist
it "renameFile, source and dest are same file" $
renameFile' (specDir `ba` "myFile")
(specDir `ba` "myFile")
renameFile' "myFile"
"myFile"
`shouldThrow`
isSameFile

View File

@@ -1 +0,0 @@
nothing

View File

@@ -1 +0,0 @@
dir

View File

@@ -1 +0,0 @@
file

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1 +0,0 @@
inputDir/

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1 +0,0 @@
dadasasddas

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1,8 +0,0 @@
dadasasddas
sda
!!1
sda
11

View File

@@ -1,4 +0,0 @@
dadasasddas
das
sda
sda

View File

@@ -1 +0,0 @@
inputDir/

View File

@@ -1,16 +0,0 @@
adaöölsdaöl
dsalö
ölsda
ääödsf
äsdfä
öä453
öä
435
ä45343
5
453
453453453
das
asd
das

View File

@@ -1,4 +0,0 @@
abc
def
dsadasdsa

View File

@@ -1 +0,0 @@
inputFile

View File

@@ -1,2 +0,0 @@
abc
def

View File

@@ -1 +0,0 @@
inputFile

View File

@@ -1 +0,0 @@
dir

View File

@@ -1 +0,0 @@
dir

View File

@@ -1 +0,0 @@
foo

Some files were not shown because too many files have changed in this diff Show More