97 Commits
0.5.9 ... 0.8.1

Author SHA1 Message Date
1c95c9f8f9 Bump to 0.8.1 2018-04-06 17:22:57 +02:00
0ec2cf8ca5 Add writeFile and appendFile 2018-04-06 17:22:38 +02:00
9ac10a6a7d Add file reading functions 2018-04-06 16:42:40 +02:00
1a2c77c6a6 dirname: remove incorrect documentation on properties
Fixes #11
2017-01-14 20:16:25 +01:00
3baecb7b51 Improve CopyDirRecursiveCollectFailures tests 2016-06-14 19:32:33 +02:00
5d5b0ae3c1 Add missing language pragma 2016-06-14 19:32:14 +02:00
f47c8edb42 Fix build for GHC < 7.10 2016-06-14 19:21:03 +02:00
ef66a24f87 Improve error handling
* remove some obsolete functions and error types from HPath.IO.Errors
  that are completely unused
* reworked the RecursiveFailure type to contain more information,
  so we can use it to programmatically make useful choices
  without examining the weakly types IO error attributes (like
  'ioGetFileName')
2016-06-14 19:13:25 +02:00
f6a5cb8668 Add test to basename 2016-06-13 13:51:53 +02:00
4dec385332 Improve createDirRecursive 2016-06-13 01:38:44 +02:00
5b08e14b55 Add createDirRecursive, fixes #6 2016-06-13 01:28:55 +02:00
ac381cbf60 Improve documentation 2016-06-05 22:19:30 +02:00
ce7fdcdcd6 Move documentation note about RecursiveFailure where it belongs 2016-06-05 22:04:16 +02:00
a31c9d1e88 Improve documentation and tests for file creation 2016-06-05 21:59:31 +02:00
a5942ff026 Use IfElse package for whenM/unlessM 2016-06-05 21:52:52 +02:00
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
456af3b1ab Release 0.6.0 2016-05-10 00:45:40 +02:00
f841a53985 HPath.IO: pretty 2016-05-10 00:36:51 +02:00
eb27c368e6 HPath.IO.Errors: explicit exports, improve haddock compat 2016-05-10 00:35:33 +02:00
c76df7f159 HPath.IO: small cleanup 2016-05-10 00:28:04 +02:00
613754c58f HPath.IO: just do 'return ()' on unsupported file types where possible
Breaking the callstack with an ioError seems a bit harsh here.
2016-05-10 00:27:46 +02:00
d8b0b99edf HPath.IO.Errors: provide all exception constructor checkers 2016-05-10 00:13:14 +02:00
794c3a2fc4 HPath.IO.Errors: remove obsolete HPathIOException constructors 2016-05-10 00:12:43 +02:00
8a28a5dd0f HPath.IO.Errors: fix throwDestinationInSource
'canonicalizePath' was missing, making this function far less reliable.
In order for this to work we have to work around circular imports
with a IO.hs-boot file.
2016-05-10 00:11:42 +02:00
150 changed files with 3489 additions and 1880 deletions

View File

@@ -9,15 +9,22 @@ matrix:
include: include:
- env: CABALVER=1.22 GHCVER=7.8.4 - env: CABALVER=1.22 GHCVER=7.8.4
addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-1.22,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.10.2 - env: CABALVER=1.24 GHCVER=7.10.2
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}} 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 - env: CABALVER=head GHCVER=head
addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}} addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
allow_failures: allow_failures:
- env: CABALVER=head GHCVER=head - 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: before_install:
- sudo apt-get install -y hscolour
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
install: install:
@@ -32,6 +39,7 @@ script:
- cabal test - cabal test
- cabal check - cabal check
- cabal sdist - 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 # check that the generated source-distribution can be built & installed
- export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;
cd dist/; cd dist/;
@@ -41,7 +49,11 @@ script:
else else
echo "expected '$SRC_TGZ' not found"; echo "expected '$SRC_TGZ' not found";
exit 1; exit 1;
fi fi;
cd ..
after_script:
- ./update-gh-pages.sh
notifications: notifications:
email: email:

View File

@@ -1,3 +1,35 @@
0.8.1
* add 'readFile', 'readFileEOF', 'writeFile' and 'appendFile'
0.8.0
* 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument
* introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior)
* 'createRegularFile' and 'createDir' now take FileMode as a parameter (also see 'newFilePerms' and 'newDirPerms')
* various documentation fixes
* improved reliability of tests
0.7.5:
* relicense to BSD3
0.7.3:
* don't expose HPath.Internal
0.7.2:
* fix tests, so they work with the sdist tarball too
* added the following function to HPath.IO: createSymlink
0.7.1:
* various cleanups and documentation improvements
* added the following functions to System.Posix.FilePath: splitSearchPath, getSearchPath, stripExtension, makeRelative, makeValid
0.7.0:
* use 'sendfile' from 'simple-sendfile' in _copyFile and do read/write as a fallback only
* add isFileName, hasParentDir, hiddenFile to System.Posix.FilePath
* add our own openFd version for more control
* small documentation improvements
* add a getDirectoryContents' version that works on Fd
* lift version constraints in benchmark
* remove fpToString and userStringToFP, use Data.ByteString.UTF8 directly instead
0.6.0:
* fixes 'throwDestinationInSource' to be more reliable.
* removes some unused HPathIOException constructors
* consistently provide exception constructor identifiers
* be less harsh when non-supported file types get passed to our functions, possibly ignoring them
* minor cleanups
0.5.9: 0.5.9:
* Adds our posix-paths fork and a lot of IO operations. * Adds our posix-paths fork and a lot of IO operations.
0.5.8: 0.5.8:

358
LICENSE
View File

@@ -1,340 +1,30 @@
GNU GENERAL PUBLIC LICENSE Copyright (c) Julian Ospald
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc., All rights reserved.
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.
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 1. Redistributions of source code must retain the above copyright
freedom to share and change it. By contrast, the GNU General Public notice, this list of conditions and the following disclaimer.
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.
When we speak of free software, we are referring to freedom, not 2. Redistributions in binary form must reproduce the above copyright
price. Our General Public Licenses are designed to make sure that you notice, this list of conditions and the following disclaimer in the
have the freedom to distribute copies of free software (and charge for documentation and/or other materials provided with the distribution.
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.
To protect your rights, we need to make restrictions that forbid 3. Neither the name of the author nor the names of his contributors
anyone to deny you these rights or to ask you to surrender the rights. may be used to endorse or promote products derived from this software
These restrictions translate to certain responsibilities for you if you without specific prior written permission.
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.
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 # 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 Support for well-typed paths in Haskell. Also provides ByteString based filepath
manipulation. 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 * safe filepath manipulation, never using String as filepath, but ByteString
* still allowing sufficient control to interact with the underlying low-level calls * 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' ## 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... * 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' ## 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` * 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 name: hpath
version: 0.5.9 version: 0.8.1
synopsis: Support for well-typed paths synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood. description: Support for well-typed paths, utilizing ByteString under the hood.
license: GPL-2 license: BSD3
license-file: LICENSE license-file: LICENSE
author: Julian Ospald <hasufell@posteo.de> author: Julian Ospald <hasufell@posteo.de>
maintainer: Julian Ospald <hasufell@posteo.de> maintainer: Julian Ospald <hasufell@posteo.de>
@@ -12,7 +12,6 @@ build-type: Simple
cabal-version: >=1.14 cabal-version: >=1.14
extra-source-files: README.md extra-source-files: README.md
CHANGELOG CHANGELOG
benchmarks/*.hs
cbits/dirutils.h cbits/dirutils.h
doctests-hpath.hs doctests-hpath.hs
doctests-posix.hs doctests-posix.hs
@@ -20,21 +19,26 @@ extra-source-files: README.md
library library
hs-source-dirs: src/ hs-source-dirs: src/
default-language: Haskell2010 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 c-sources: cbits/dirutils.c
exposed-modules: HPath, exposed-modules: HPath,
HPath.IO, HPath.IO,
HPath.IO.Errors, HPath.IO.Errors,
HPath.IO.Utils,
HPath.Internal,
System.Posix.Directory.Foreign, System.Posix.Directory.Foreign,
System.Posix.Directory.Traversals, System.Posix.Directory.Traversals,
System.Posix.FD,
System.Posix.FilePath System.Posix.FilePath
other-modules: HPath.Internal
build-depends: base >= 4.2 && <5 build-depends: base >= 4.2 && <5
, IfElse
, bytestring >= 0.9.2.0 , bytestring >= 0.9.2.0
, deepseq , deepseq
, exceptions , exceptions
, hspec , hspec
, simple-sendfile >= 0.2.24
, unix >= 2.5 , unix >= 2.5
, unix-bytestring , unix-bytestring
, utf8-string , utf8-string
@@ -71,50 +75,40 @@ test-suite spec
Hs-Source-Dirs: test Hs-Source-Dirs: test
Main-Is: Main.hs Main-Is: Main.hs
other-modules: other-modules:
Spec HPath.IO.CanonicalizePathSpec
HPath.IO.CopyDirRecursiveSpec HPath.IO.CopyDirRecursiveCollectFailuresSpec
HPath.IO.CopyDirRecursiveOverwriteSpec HPath.IO.CopyDirRecursiveOverwriteSpec
HPath.IO.CopyFileSpec HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyFileOverwriteSpec HPath.IO.CopyFileOverwriteSpec
HPath.IO.CopyFileSpec
HPath.IO.CreateDirSpec HPath.IO.CreateDirSpec
HPath.IO.CreateDirRecursiveSpec
HPath.IO.CreateRegularFileSpec HPath.IO.CreateRegularFileSpec
HPath.IO.CreateSymlinkSpec
HPath.IO.DeleteDirRecursiveSpec HPath.IO.DeleteDirRecursiveSpec
HPath.IO.DeleteDirSpec HPath.IO.DeleteDirSpec
HPath.IO.DeleteFileSpec HPath.IO.DeleteFileSpec
HPath.IO.GetDirsFilesSpec HPath.IO.GetDirsFilesSpec
HPath.IO.GetFileTypeSpec HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileSpec
HPath.IO.MoveFileOverwriteSpec HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec
HPath.IO.RecreateSymlinkOverwriteSpec
HPath.IO.RecreateSymlinkSpec HPath.IO.RecreateSymlinkSpec
HPath.IO.RenameFileSpec HPath.IO.RenameFileSpec
Spec
Utils Utils
GHC-Options: -Wall GHC-Options: -Wall
Build-Depends: base Build-Depends: base
, HUnit , HUnit
, IfElse
, bytestring , bytestring
, hpath , hpath
, hspec >= 1.3 , hspec >= 1.3
, process , process
, unix , unix
, unix-bytestring
, utf8-string , 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 source-repository head
type: git type: git
location: https://github.com/hasufell/hpath location: https://github.com/hasufell/hpath

View File

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

View File

@@ -1,7 +1,7 @@
-- | -- |
-- Module : HPath.IO -- Module : HPath.IO
-- Copyright : © 2016 Julian Ospald -- Copyright : © 2016 Julian Ospald
-- License : GPL-2 -- License : BSD3
-- --
-- Maintainer : Julian Ospald <hasufell@posteo.de> -- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental -- Stability : experimental
@@ -26,8 +26,9 @@
-- exception handling is kept. -- exception handling is kept.
-- --
-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket` -- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`
-- are not explicitly supported right now. Calling any of these -- are ignored by some of the more high-level functions (like `easyCopy`).
-- functions on such a file may throw an exception. -- 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 PackageImports #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
@@ -36,14 +37,13 @@ module HPath.IO
( (
-- * Types -- * Types
FileType(..) FileType(..)
, RecursiveErrorMode(..)
, CopyMode(..)
-- * File copying -- * File copying
, copyDirRecursive , copyDirRecursive
, copyDirRecursiveOverwrite
, recreateSymlink , recreateSymlink
, copyFile , copyFile
, copyFileOverwrite
, easyCopy , easyCopy
, easyCopyOverwrite
-- * File deletion -- * File deletion
, deleteFile , deleteFile
, deleteDir , deleteDir
@@ -55,10 +55,17 @@ module HPath.IO
-- * File creation -- * File creation
, createRegularFile , createRegularFile
, createDir , createDir
, createDirRecursive
, createSymlink
-- * File renaming/moving -- * File renaming/moving
, renameFile , renameFile
, moveFile , moveFile
, moveFileOverwrite -- * File reading
, readFile
, readFileEOF
-- * File writing
, writeFile
, appendFile
-- * File permissions -- * File permissions
, newFilePerms , newFilePerms
, newDirPerms , newDirPerms
@@ -78,27 +85,54 @@ import Control.Applicative
) )
import Control.Exception import Control.Exception
( (
bracket IOException
, bracketOnError , bracket
, throwIO , throwIO
) )
import Control.Monad import Control.Monad
( (
void unless
, void
, when , when
) )
import Control.Monad.IfElse
(
unlessM
)
import Data.ByteString import Data.ByteString
( (
ByteString ByteString
) )
import Data.ByteString.Builder
(
Builder
, byteString
, toLazyByteString
)
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Unsafe
(
unsafePackCStringFinalizer
)
import Data.Foldable import Data.Foldable
( (
for_ for_
) )
import Data.IORef
(
IORef
, modifyIORef
, newIORef
, readIORef
)
import Data.Maybe import Data.Maybe
( (
catMaybes catMaybes
) )
import Data.Monoid
(
(<>)
)
import Data.Word import Data.Word
( (
Word8 Word8
@@ -106,8 +140,12 @@ import Data.Word
import Foreign.C.Error import Foreign.C.Error
( (
eEXIST eEXIST
, eINVAL
, eNOENT
, eNOSYS
, eNOTEMPTY , eNOTEMPTY
, eXDEV , eXDEV
, getErrno
) )
import Foreign.C.Types import Foreign.C.Types
( (
@@ -128,13 +166,17 @@ import GHC.IO.Exception
import HPath import HPath
import HPath.Internal import HPath.Internal
import HPath.IO.Errors import HPath.IO.Errors
import HPath.IO.Utils import Prelude hiding (appendFile, readFile, writeFile)
import Prelude hiding (readFile)
import System.IO.Error import System.IO.Error
( (
catchIOError catchIOError
, ioeGetErrorType , ioeGetErrorType
) )
import System.Linux.Sendfile
(
sendfileFd
, FileRange(..)
)
import System.Posix.ByteString import System.Posix.ByteString
( (
exclusive exclusive
@@ -171,6 +213,10 @@ import System.Posix.Files.ByteString
import qualified System.Posix.Files.ByteString as PF import qualified System.Posix.Files.ByteString as PF
import qualified "unix" System.Posix.IO.ByteString as SPI import qualified "unix" System.Posix.IO.ByteString as SPI
import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB 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.Traversals as SPDT
import qualified System.Posix.Directory.Foreign as SPDF import qualified System.Posix.Directory.Foreign as SPDF
import qualified System.Posix.Process.ByteString as SPP import qualified System.Posix.Process.ByteString as SPP
@@ -185,6 +231,11 @@ import System.Posix.Types
-------------
--[ Types ]--
-------------
data FileType = Directory data FileType = Directory
| RegularFile | RegularFile
| SymbolicLink | SymbolicLink
@@ -196,6 +247,28 @@ data FileType = Directory
-- |The error mode for recursive operations.
--
-- 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. Also note that
-- `RecursiveFailure` does not give any guarantees on the ordering
-- of the collected exceptions.
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
-------------------- --------------------
@@ -204,8 +277,22 @@ data FileType = Directory
-- |Copies a directory recursively to the given destination. -- |Copies the contents of a directory recursively to the given destination, while preserving permissions.
-- Does not follow symbolic links. -- Does not follow symbolic links. This behaves more or less like
-- the following, without descending into the destination if it
-- already exists:
--
-- @
-- cp -a \/source\/dir \/destination\/somedir
-- @
--
-- For directory contents, this will ignore any file type that is not
-- `RegularFile`, `SymbolicLink` or `Directory`.
--
-- For `Overwrite` copy mode this does not prune destination directory
-- contents, so the destination might contain more files than the source after
-- the operation has completed. Permissions of existing directories are
-- fixed.
-- --
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
@@ -219,108 +306,138 @@ data FileType = Directory
-- Throws: -- Throws:
-- --
-- - `NoSuchThing` if source directory does not exist -- - `NoSuchThing` if source directory does not exist
-- - `PermissionDenied` if output directory is not writable
-- - `PermissionDenied` if source directory can't be opened -- - `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 (symlink)
-- - `InvalidArgument` if source directory is wrong type (regular file) -- - `InappropriateType` if source directory is wrong type (regular file)
-- - `SameFile` if source and destination are the same file (`HPathIOException`) --
-- 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 -- - `AlreadyExists` if destination already exists
-- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
copyDirRecursive :: Path Abs -- ^ source dir copyDirRecursive :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination -> Path Abs -- ^ destination (parent dirs
-- are not automatically created)
-> CopyMode
-> RecursiveErrorMode
-> IO () -> IO ()
copyDirRecursive fromp destdirp copyDirRecursive fromp destdirp cm rm
= do = do
ce <- newIORef []
-- for performance, sanity checks are only done for the top dir -- for performance, sanity checks are only done for the top dir
throwSameFile fromp destdirp throwSameFile fromp destdirp
throwDestinationInSource fromp destdirp throwDestinationInSource fromp destdirp
go fromp destdirp go ce fromp destdirp
collectedExceptions <- readIORef ce
unless (null collectedExceptions)
(throwIO . RecursiveFailure $ collectedExceptions)
where where
go :: Path Abs -> Path Abs -> IO () go :: IORef [(RecursiveFailureHint, IOException)]
go fromp' destdirp' = do -> Path Abs -> Path Abs -> IO ()
-- order is important here, so we don't get empty directories go ce fromp' destdirp' = do
-- NOTE: order is important here, so we don't get empty directories
-- on failure -- on failure
contents <- getDirsFiles fromp'
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp') -- get the contents of the source dir
createDirectory (fromAbs destdirp') fmode' contents <- handleIOE (ReadContentsFailed fromp' destdirp') ce [] $ do
contents <- getDirsFiles fromp'
-- create the destination dir and
-- only return contents if we succeed
handleIOE (CreateDirFailed fromp' destdirp') ce [] $ do
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
-- NOTE: we can't use `easyCopy` here, because we want to call `go`
-- recursively to skip the top-level sanity checks
-- if reading the contents and creating the destination dir worked,
-- then copy the contents to the destination too
for_ contents $ \f -> do for_ contents $ \f -> do
ftype <- getFileType f ftype <- getFileType f
newdest <- (destdirp' </>) <$> basename f newdest <- (destdirp' </>) <$> basename f
case ftype of case ftype of
SymbolicLink -> recreateSymlink f newdest SymbolicLink -> handleIOE (RecreateSymlinkFailed f newdest) ce ()
Directory -> go f newdest $ recreateSymlink f newdest cm
RegularFile -> copyFile f newdest Directory -> go ce f newdest
_ -> ioError $ userError $ "No idea what to do with the" ++ RegularFile -> handleIOE (CopyFileFailed f newdest) ce ()
"given filetype: " ++ show ftype $ copyFile f newdest cm
_ -> return ()
-- helper to handle errors for both RecursiveErrorModes and return a
-- |Like `copyDirRecursive` except it overwrites contents of directories -- default value
-- if any. handleIOE :: RecursiveFailureHint
-- -> IORef [(RecursiveFailureHint, IOException)]
-- Throws: -> a -> IO a -> IO a
-- handleIOE hint ce def = case rm of
-- - `NoSuchThing` if source directory does not exist FailEarly -> handleIOError throwIO
-- - `PermissionDenied` if output directory is not writable CollectFailures -> handleIOError (\e -> modifyIORef ce ((hint, e):)
-- - `PermissionDenied` if source directory can't be opened >> return def)
-- - `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
_ -> ioError $ userError $ "No idea what to do with the" ++
"given filetype: " ++ show ftype
-- |Recreate a symlink. -- |Recreate a symlink.
-- --
-- In `Overwrite` copy mode only files and empty directories are deleted.
--
-- Safety/reliability concerns:
--
-- * `Overwrite` mode is inherently non-atomic
--
-- Throws: -- Throws:
-- --
-- - `InvalidArgument` if symlink file is wrong type (file) -- - `InvalidArgument` if source file is wrong type (not a symlink)
-- - `InvalidArgument` if symlink file is wrong type (directory)
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened -- - `PermissionDenied` if source directory cannot be opened
-- - `AlreadyExists` if destination file already exists -- - `SameFile` if source and destination are the same file
-- - `SameFile` if source and destination are the same file (`HPathIOException`) -- (`HPathIOException`)
--
--
-- Throws in `Strict` mode only:
--
-- - `AlreadyExists` if destination already exists
--
-- Throws in `Overwrite` mode only:
--
-- - `UnsatisfiedConstraints` if destination file is non-empty directory
-- --
-- Note: calls `symlink` -- Note: calls `symlink`
recreateSymlink :: Path Abs -- ^ the old symlink file recreateSymlink :: Path Abs -- ^ the old symlink file
-> Path Abs -- ^ destination file -> Path Abs -- ^ destination file
-> CopyMode
-> IO () -> IO ()
recreateSymlink symsource newsym recreateSymlink symsource newsym cm
= do = do
throwSameFile symsource newsym throwSameFile symsource newsym
sympoint <- readSymbolicLink (fromAbs symsource) 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) createSymbolicLink sympoint (fromAbs newsym)
@@ -328,64 +445,62 @@ recreateSymlink symsource newsym
-- Neither follows symbolic links, nor accepts them. -- Neither follows symbolic links, nor accepts them.
-- For "copying" symbolic links, use `recreateSymlink` instead. -- 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 -- In `Overwrite` copy mode only overwrites actual files, not directories.
-- - `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.
-- --
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
-- * not atomic -- * `Overwrite` mode is not atomic
-- * falls back to delete-copy method with explicit checks -- * 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: -- Throws:
-- --
-- - `NoSuchThing` if source file does not exist -- - `NoSuchThing` if source file does not exist
-- - `NoSuchThing` if source file is a a `Socket`
-- - `PermissionDenied` if output directory is not writable -- - `PermissionDenied` if output directory is not writable
-- - `PermissionDenied` if source directory can't be opened -- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source file is wrong type (symlink) -- - `InvalidArgument` if source file is wrong type (symlink or directory)
-- - `InvalidArgument` if source file is wrong type (directory) -- - `SameFile` if source and destination are the same file
-- - `SameFile` if source and destination are the same file (`HPathIOException`) -- (`HPathIOException`)
-- --
-- Note: calls `sendfile` -- Throws in `Strict` mode only:
copyFileOverwrite :: Path Abs -- ^ source file --
-> Path Abs -- ^ destination file -- - `AlreadyExists` if destination already exists
-> IO () --
copyFileOverwrite from to = do -- 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 throwSameFile from to
catchIOError (_copyFile [SPDF.oNofollow]
[SPDF.oNofollow, SPDF.oTrunc] case cm of
from to) $ \e -> Strict -> _copyFile [SPDF.oNofollow]
case ioeGetErrorType e of [SPDF.oNofollow, SPDF.oExcl]
-- if the destination file is not writable, we need to from to
-- figure out if we can still copy by deleting it first Overwrite ->
PermissionDenied -> do catchIOError (_copyFile [SPDF.oNofollow]
exists <- doesFileExist to [SPDF.oNofollow, SPDF.oTrunc]
writable <- isWritable (dirname to) from to) $ \e ->
if exists && writable case ioeGetErrorType e of
then deleteFile to >> copyFile from to -- if the destination file is not writable, we need to
else ioError e -- figure out if we can still copy by deleting it first
_ -> ioError e 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] _copyFile :: [SPDF.Flags]
@@ -395,24 +510,35 @@ _copyFile :: [SPDF.Flags]
-> IO () -> IO ()
_copyFile sflags dflags from to _copyFile sflags dflags from to
= =
-- TODO: add sendfile support -- 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' -> withAbsPath to $ \to' -> withAbsPath from $ \from' ->
void $ fallbackCopy from' to' catchErrno [eINVAL, eNOSYS]
(sendFileCopy from' to')
(void $ readWriteCopy from' to')
where where
-- low-level copy operation utilizing read(2)/write(2) copyWith copyAction source dest =
-- in case `sendFileCopy` fails/is unsupported bracket (openFd source SPI.ReadOnly sflags Nothing)
fallbackCopy source dest =
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
SPI.closeFd SPI.closeFd
$ \sfd -> do $ \sfd -> do
fileM <- System.Posix.Files.ByteString.fileMode fileM <- System.Posix.Files.ByteString.fileMode
<$> getFdStatus sfd <$> getFdStatus sfd
bracketeer (SPDT.openFd dest SPI.WriteOnly bracketeer (openFd dest SPI.WriteOnly
dflags $ Just fileM) dflags $ Just fileM)
SPI.closeFd SPI.closeFd
(\fd -> SPI.closeFd fd >> deleteFile to) (\fd -> SPI.closeFd fd >> deleteFile to)
$ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf -> $ \dfd -> copyAction sfd dfd
write' sfd dfd buf 0 -- 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 where
bufSize :: CSize bufSize :: CSize
bufSize = 8192 bufSize = 8192
@@ -422,12 +548,14 @@ _copyFile sflags dflags from to
if size == 0 if size == 0
then return $ fromIntegral totalsize then return $ fromIntegral totalsize
else do rsize <- SPB.fdWriteBuf dfd buf size else do rsize <- SPB.fdWriteBuf dfd buf size
when (rsize /= size) (throwIO . CopyFailed $ "wrong size!") when (rsize /= size) (ioError $ userError
"wrong size!")
write' sfd dfd buf (totalsize + fromIntegral size) write' sfd dfd buf (totalsize + fromIntegral size)
-- |Copies anything. In case of a symlink, -- |Copies a regular file, directory or symbolic link. In case of a
-- it is just recreated, even if it points to a directory. -- symbolic link it is just recreated, even if it points to a directory.
-- Any other file type is ignored.
-- --
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
@@ -435,33 +563,16 @@ _copyFile sflags dflags from to
-- * calls `copyDirRecursive` for directories -- * calls `copyDirRecursive` for directories
easyCopy :: Path Abs easyCopy :: Path Abs
-> Path Abs -> Path Abs
-> CopyMode
-> RecursiveErrorMode
-> IO () -> IO ()
easyCopy from to = do easyCopy from to cm rm = do
ftype <- getFileType from ftype <- getFileType from
case ftype of case ftype of
SymbolicLink -> recreateSymlink from to SymbolicLink -> recreateSymlink from to cm
RegularFile -> copyFile from to RegularFile -> copyFile from to cm
Directory -> copyDirRecursive from to Directory -> copyDirRecursive from to cm rm
_ -> ioError $ userError $ "No idea what to do with the" ++ _ -> return ()
"given filetype: " ++ show ftype
-- |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
_ -> ioError $ userError $ "No idea what to do with the" ++
"given filetype: " ++ show ftype
@@ -472,7 +583,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. -- if run on a directory. Does not follow symbolic links.
-- --
-- Throws: -- Throws:
@@ -503,6 +614,10 @@ deleteDir p = withAbsPath p removeDirectory
-- links. Tries `deleteDir` first before attemtping a recursive -- links. Tries `deleteDir` first before attemtping a recursive
-- deletion. -- 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: -- Safety/reliability concerns:
-- --
-- * not atomic -- * not atomic
@@ -526,14 +641,14 @@ deleteDirRecursive p =
SymbolicLink -> deleteFile file SymbolicLink -> deleteFile file
Directory -> deleteDirRecursive file Directory -> deleteDirRecursive file
RegularFile -> deleteFile file RegularFile -> deleteFile file
_ -> ioError $ userError $ "No idea what to do with the" ++ _ -> return ()
"given filetype: " ++ show ftype
removeDirectory . toFilePath $ 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 -- In case of directory, performs recursive deletion. In case of
-- a symlink, the symlink file is deleted. -- a symlink, the symlink file is deleted.
-- Any other file type is ignored.
-- --
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
@@ -546,8 +661,7 @@ easyDelete p = do
SymbolicLink -> deleteFile p SymbolicLink -> deleteFile p
Directory -> deleteDirRecursive p Directory -> deleteDirRecursive p
RegularFile -> deleteFile p RegularFile -> deleteFile p
_ -> ioError $ userError $ "No idea what to do with the" ++ _ -> return ()
"given filetype: " ++ show ftype
@@ -583,15 +697,18 @@ 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: -- Throws:
-- --
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination file already exists -- - `AlreadyExists` if destination already exists
createRegularFile :: Path Abs -> IO () -- - `NoSuchThing` if any of the parent components of the path
createRegularFile dest = -- do not exist
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.defaultFileFlags { exclusive = True }))
SPI.closeFd SPI.closeFd
(\_ -> return ()) (\_ -> return ())
@@ -602,11 +719,58 @@ createRegularFile dest =
-- Throws: -- Throws:
-- --
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination directory already exists -- - `AlreadyExists` if destination already exists
createDir :: Path Abs -> IO () -- - `NoSuchThing` if any of the parent components of the path
createDir dest = createDirectory (fromAbs dest) newDirPerms -- do not exist
createDir :: FileMode -> Path Abs -> IO ()
createDir fm dest = createDirectory (fromAbs dest) fm
-- |Create an empty directory at the given directory with the given filename.
-- All parent directories are created with the same filemode. This
-- basically behaves like:
--
-- @
-- mkdir -p \/some\/dir
-- @
--
-- Safety/reliability concerns:
--
-- * not atomic
--
-- Throws:
--
-- - `PermissionDenied` if any part of the path components do not
-- exist and cannot be written to
-- - `AlreadyExists` if destination already exists and
-- is not a directory
createDirRecursive :: FileMode -> Path Abs -> IO ()
createDirRecursive fm dest =
catchIOError (createDirectory (fromAbs dest) fm) $ \e -> do
errno <- getErrno
case errno of
en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e)
| en == eNOENT -> createDirRecursive fm (dirname dest)
>> createDirectory (fromAbs dest) fm
| otherwise -> ioError e
-- |Create a symlink.
--
-- Throws:
--
-- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination file already exists
-- - `NoSuchThing` if any of the parent components of the path
-- do not exist
--
-- Note: calls `symlink`
createSymlink :: Path Abs -- ^ destination file
-> ByteString -- ^ path the symlink points to
-> IO ()
createSymlink dest sympoint
= createSymbolicLink sympoint (fromAbs dest)
---------------------------- ----------------------------
@@ -628,10 +792,11 @@ createDir dest = createDirectory (fromAbs dest) newDirPerms
-- - `NoSuchThing` if source file does not exist -- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened -- - `PermissionDenied` if source directory cannot be opened
-- - `UnsupportedOperation` if source and destination are on different devices -- - `UnsupportedOperation` if source and destination are on different
-- - `FileDoesExist` if destination file already exists -- devices
-- - `DirDoesExist` if destination directory already exists -- - `AlreadyExists` if destination already exists
-- - `SameFile` if destination and source are the same file (`HPathIOException`) -- - `SameFile` if destination and source are the same file
-- (`HPathIOException`)
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Note: calls `rename` (but does not allow to rename over existing files)
renameFile :: Path Abs -> Path Abs -> IO () renameFile :: Path Abs -> Path Abs -> IO ()
@@ -647,67 +812,161 @@ renameFile fromf tof = do
-- --
-- Does not follow symbolic links, but renames the symbolic link file. -- Does not follow symbolic links, but renames the symbolic link file.
-- --
--
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
-- * `Overwrite` mode is not atomic
-- * copy-delete fallback is inherently non-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: -- Throws:
-- --
-- - `NoSuchThing` if source file does not exist -- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened -- - `PermissionDenied` if source directory cannot be opened
-- - `FileDoesExist` if destination file already exists -- - `SameFile` if destination and source are the same file
-- - `DirDoesExist` if destination directory already exists -- (`HPathIOException`)
-- - `SameFile` if destination and source are the same file (`HPathIOException`) --
-- Throws in `Strict` mode only:
--
-- - `AlreadyExists` if destination already exists
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Note: calls `rename` (but does not allow to rename over existing files)
moveFile :: Path Abs -- ^ file to move moveFile :: Path Abs -- ^ file to move
-> Path Abs -- ^ destination -> Path Abs -- ^ destination
-> CopyMode
-> IO () -> IO ()
moveFile from to = do moveFile from to cm = do
throwSameFile from to throwSameFile from to
catchErrno [eXDEV] (renameFile from to) $ do case cm of
easyCopy from to Strict -> catchErrno [eXDEV] (renameFile from to) $ do
easyDelete from 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.
--------------------
--[ File Reading ]--
--------------------
-- |Read the given file at once into memory as a strict ByteString.
-- Symbolic links are followed, no sanity checks on file size
-- or file type. File must exist.
-- --
-- Does not follow symbolic links, but renames the symbolic link file. -- Note: the size of the file is determined in advance, as to only
-- have one allocation.
-- --
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
-- * copy-delete fallback is inherently non-atomic -- * since amount of bytes to read is determined in advance,
-- * checks for file types and destination file existence explicitly -- the file might be read partially only if something else is
-- appending to it while reading
-- * the whole file is read into memory!
-- --
-- Throws: -- Throws:
-- --
-- - `NoSuchThing` if source file does not exist -- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if we cannot read the file or the directory
-- - `PermissionDenied` if source directory cannot be opened -- containting it
-- - `SameFile` if destination and source are the same file (`HPathIOException`) -- - `NoSuchThing` if the file does not exist
readFile :: Path Abs -> IO ByteString
readFile p = withAbsPath p $ \fp ->
bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> do
stat <- PF.getFdStatus fd
let fsize = PF.fileSize stat
SPB.fdRead fd (fromIntegral fsize)
-- |Read the given file in chunks of size `8192` into memory until
-- `fread` returns 0. Returns a lazy ByteString, because it uses
-- Builders under the hood.
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Safety/reliability concerns:
moveFileOverwrite :: Path Abs -- ^ file to move --
-> Path Abs -- ^ destination -- * the whole file is read into memory!
-> IO () --
moveFileOverwrite from to = do -- Throws:
throwSameFile from to --
ft <- getFileType from -- - `InappropriateType` if file is not a regular file or a symlink
writable <- isWritable $ dirname to -- - `PermissionDenied` if we cannot read the file or the directory
case ft of -- containting it
RegularFile -> do -- - `NoSuchThing` if the file does not exist
exists <- doesFileExist to readFileEOF :: Path Abs -> IO L.ByteString
when (exists && writable) (deleteFile to) readFileEOF p = withAbsPath p $ \fp ->
SymbolicLink -> do bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd ->
exists <- doesFileExist to allocaBytes (fromIntegral bufSize) $ \buf -> read' fd buf mempty
when (exists && writable) (deleteFile to) where
Directory -> do bufSize :: CSize
exists <- doesDirectoryExist to bufSize = 8192
when (exists && writable) (deleteDir to) read' :: Fd -> Ptr Word8 -> Builder -> IO L.ByteString
_ -> ioError $ userError $ "Don't know how to handle filetype " ++ read' fd buf builder = do
show ft size <- SPB.fdReadBuf fd buf bufSize
moveFile from to if size == 0
then return $ toLazyByteString builder
else do
readBS <- unsafePackCStringFinalizer buf
(fromIntegral size)
mempty
read' fd buf (builder <> byteString readBS)
--------------------
--[ File Writing ]--
--------------------
-- |Write a given ByteString to a file, truncating the file beforehand.
-- The file must exist. Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
writeFile :: Path Abs -> ByteString -> IO ()
writeFile p bs = withAbsPath p $ \fp ->
bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] Nothing) (SPI.closeFd) $ \fd ->
void $ SPB.fdWrite fd bs
-- |Append a given ByteString to a file.
-- The file must exist. Follows symlinks.
--
-- Throws:
--
-- - `InappropriateType` if file is not a regular file or a symlink
-- - `PermissionDenied` if we cannot read the file or the directory
-- containting it
-- - `NoSuchThing` if the file does not exist
appendFile :: Path Abs -> ByteString -> IO ()
appendFile p bs = withAbsPath p $ \fp ->
bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing)
(SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs
@@ -747,6 +1006,8 @@ newDirPerms
-- |Gets all filenames of the given directory. This excludes "." and "..". -- |Gets all filenames of the given directory. This excludes "." and "..".
-- This version does not follow symbolic links. -- This version does not follow symbolic links.
-- --
-- The contents are not sorted and there is no guarantee on the ordering.
--
-- Throws: -- Throws:
-- --
-- - `NoSuchThing` if directory does not exist -- - `NoSuchThing` if directory does not exist
@@ -757,14 +1018,12 @@ newDirPerms
getDirsFiles :: Path Abs -- ^ dir to read getDirsFiles :: Path Abs -- ^ dir to read
-> IO [Path Abs] -> IO [Path Abs]
getDirsFiles p = getDirsFiles p =
withAbsPath p $ \fp -> withAbsPath p $ \fp -> do
bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing) fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing
SPI.closeFd return
$ \fd -> . catMaybes
return . fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
. catMaybes =<< getDirectoryContents' fd
. fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))
=<< getDirectoryContents' fd
where where
parseMaybe :: ByteString -> Maybe (Path Fn) parseMaybe :: ByteString -> Maybe (Path Fn)
parseMaybe = parseFn parseMaybe = parseFn

7
src/HPath/IO.hs-boot Normal file
View File

@@ -0,0 +1,7 @@
module HPath.IO where
import HPath
canonicalizePath :: Path Abs -> IO (Path Abs)

View File

@@ -1,7 +1,7 @@
-- | -- |
-- Module : HPath.IO.Errors -- Module : HPath.IO.Errors
-- Copyright : © 2016 Julian Ospald -- Copyright : © 2016 Julian Ospald
-- License : GPL-2 -- License : BSD3
-- --
-- Maintainer : Julian Ospald <hasufell@posteo.de> -- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental -- Stability : experimental
@@ -12,7 +12,40 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module HPath.IO.Errors where module HPath.IO.Errors
(
-- * Types
HPathIOException(..)
, RecursiveFailureHint(..)
-- * Exception identifiers
, isSameFile
, isDestinationInSource
, isRecursiveFailure
, isReadContentsFailed
, isCreateDirFailed
, isCopyFileFailed
, isRecreateSymlinkFailed
-- * Path based functions
, throwFileDoesExist
, throwDirDoesExist
, throwSameFile
, sameFile
, throwDestinationInSource
, doesFileExist
, doesDirectoryExist
, isWritable
, canOpenDirectory
-- * Error handling functions
, catchErrno
, rethrowErrnoAs
, handleIOError
, bracketeer
, reactOnError
)
where
import Control.Applicative import Control.Applicative
@@ -25,15 +58,22 @@ import Control.Monad
forM forM
, when , when
) )
import Control.Monad.IfElse
(
whenM
)
import Data.ByteString import Data.ByteString
( (
ByteString ByteString
) )
import Data.Data import Data.ByteString.UTF8
( (
Data(..) toString
) )
import Data.Typeable import Data.Typeable
(
Typeable
)
import Foreign.C.Error import Foreign.C.Error
( (
getErrno getErrno
@@ -44,11 +84,16 @@ import GHC.IO.Exception
IOErrorType IOErrorType
) )
import HPath import HPath
import HPath.IO.Utils import {-# SOURCE #-} HPath.IO
(
canonicalizePath
)
import System.IO.Error import System.IO.Error
( (
catchIOError alreadyExistsErrorType
, catchIOError
, ioeGetErrorType , ioeGetErrorType
, mkIOError
) )
import qualified System.Posix.Directory.ByteString as PFD import qualified System.Posix.Directory.ByteString as PFD
@@ -60,74 +105,61 @@ import System.Posix.Files.ByteString
import qualified System.Posix.Files.ByteString as PF import qualified System.Posix.Files.ByteString as PF
data HPathIOException = FileDoesNotExist ByteString -- |Additional generic IO exceptions that the posix functions
| DirDoesNotExist ByteString -- do not provide.
| PathNotAbsolute ByteString data HPathIOException = SameFile ByteString ByteString
| FileNotExecutable ByteString
| SameFile ByteString ByteString
| NotAFile ByteString
| NotADir ByteString
| DestinationInSource ByteString ByteString | DestinationInSource ByteString ByteString
| FileDoesExist ByteString | RecursiveFailure [(RecursiveFailureHint, IOException)]
| DirDoesExist ByteString deriving (Eq, Show, Typeable)
| IsSymlink ByteString
| InvalidOperation String
| InvalidFileName
| Can'tOpenDirectory ByteString
| CopyFailed String
| MoveFailed String
deriving (Typeable, Eq, Data)
instance Show HPathIOException where -- |A type for giving failure hints on recursive failure, which allows
show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp -- to programmatically make choices without examining
show (DirDoesNotExist fp) = "Directory does not exist: " -- the weakly typed I/O error attributes (like `ioeGetFileName`).
++ fpToString fp --
show (PathNotAbsolute fp) = "Path not absolute: " ++ fpToString fp -- The first argument to the data constructor is always the
show (FileNotExecutable fp) = "File not executable: " -- source and the second the destination.
++ fpToString fp data RecursiveFailureHint = ReadContentsFailed (Path Abs) (Path Abs)
show (SameFile fp1 fp2) = fpToString fp1 | CreateDirFailed (Path Abs) (Path Abs)
++ " and " ++ fpToString fp2 | CopyFileFailed (Path Abs) (Path Abs)
++ " are the same file!" | RecreateSymlinkFailed (Path Abs) (Path Abs)
show (NotAFile fp) = "Not a file: " ++ fpToString fp deriving (Eq, Show)
show (NotADir fp) = "Not a directory: " ++ fpToString fp
show (DestinationInSource fp1 fp2) = fpToString fp1
++ " is contained in "
++ fpToString fp2
show (FileDoesExist fp) = "File does exist: " ++ fpToString fp
show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp
show (IsSymlink fp) = "Is a symlink: " ++ fpToString fp
show (InvalidOperation str) = "Invalid operation: " ++ str
show InvalidFileName = "Invalid file name!"
show (Can'tOpenDirectory fp) = "Can't open directory: "
++ fpToString fp
show (CopyFailed str) = "Copying failed: " ++ str
show (MoveFailed str) = "Moving failed: " ++ str
instance Exception HPathIOException instance Exception HPathIOException
toConstr :: HPathIOException -> String
isDestinationInSource :: HPathIOException -> Bool toConstr SameFile {} = "SameFile"
isDestinationInSource (DestinationInSource _ _) = True toConstr DestinationInSource {} = "DestinationInSource"
isDestinationInSource _ = False toConstr RecursiveFailure {} = "RecursiveFailure"
isSameFile :: HPathIOException -> Bool
isSameFile (SameFile _ _) = True
isSameFile _ = False
isFileDoesExist :: HPathIOException -> Bool
isFileDoesExist (FileDoesExist _) = True -----------------------------
isFileDoesExist _ = False --[ Exception identifiers ]--
-----------------------------
isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{}
isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{}
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{}
isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool
isReadContentsFailed ReadContentsFailed{} = True
isReadContentsFailed _ = False
isCreateDirFailed CreateDirFailed{} = True
isCreateDirFailed _ = False
isCopyFileFailed CopyFileFailed{} = True
isCopyFileFailed _ = False
isRecreateSymlinkFailed RecreateSymlinkFailed{} = True
isRecreateSymlinkFailed _ = False
isDirDoesExist :: HPathIOException -> Bool
isDirDoesExist (DirDoesExist _) = True
isDirDoesExist _ = False
@@ -136,28 +168,28 @@ isDirDoesExist _ = False
---------------------------- ----------------------------
-- |Throws `AlreadyExists` `IOError` if file exists.
throwFileDoesExist :: Path Abs -> IO () throwFileDoesExist :: Path Abs -> IO ()
throwFileDoesExist fp = throwFileDoesExist fp =
whenM (doesFileExist fp) (throwIO . FileDoesExist whenM (doesFileExist fp)
. fromAbs $ fp) (ioError . mkIOError
alreadyExistsErrorType
"File already exists"
Nothing
$ (Just (toString $ fromAbs fp))
)
-- |Throws `AlreadyExists` `IOError` if directory exists.
throwDirDoesExist :: Path Abs -> IO () throwDirDoesExist :: Path Abs -> IO ()
throwDirDoesExist fp = throwDirDoesExist fp =
whenM (doesDirectoryExist fp) (throwIO . DirDoesExist whenM (doesDirectoryExist fp)
. fromAbs $ fp) (ioError . mkIOError
alreadyExistsErrorType
"Directory already exists"
throwFileDoesNotExist :: Path Abs -> IO () Nothing
throwFileDoesNotExist fp = $ (Just (toString $ fromAbs fp))
unlessM (doesFileExist fp) (throwIO . FileDoesNotExist )
. fromAbs $ fp)
throwDirDoesNotExist :: Path Abs -> IO ()
throwDirDoesNotExist fp =
unlessM (doesDirectoryExist fp) (throwIO . DirDoesNotExist
. fromAbs $ fp)
-- |Uses `isSameFile` and throws `SameFile` if it returns True. -- |Uses `isSameFile` and throws `SameFile` if it returns True.
@@ -184,18 +216,18 @@ sameFile fp1 fp2 =
else return False else return False
-- TODO: make this more robust when destination does not exist
-- |Checks whether the destination directory is contained -- |Checks whether the destination directory is contained
-- within the source directory by comparing the device+file ID of the -- within the source directory by comparing the device+file ID of the
-- source directory with all device+file IDs of the parent directories -- source directory with all device+file IDs of the parent directories
-- of the destination. -- of the destination.
throwDestinationInSource :: Path Abs -- ^ source dir throwDestinationInSource :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination, `dirname dest` -> Path Abs -- ^ full destination, @dirname dest@
-- must exist -- must exist
-> IO () -> IO ()
throwDestinationInSource source dest = do throwDestinationInSource source dest = do
dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest) dest' <- (\x -> maybe x (\y -> x </> y) $ basename dest)
{- <$> (canonicalizePath $ P.dirname dest) -} <$> (canonicalizePath $ dirname dest)
<$> (return $ dirname dest)
dids <- forM (getAllParents dest') $ \p -> do dids <- forM (getAllParents dest') $ \p -> do
fs <- PF.getSymbolicLinkStatus (fromAbs p) fs <- PF.getSymbolicLinkStatus (fromAbs p)
return (PF.deviceID fs, PF.fileID fs) return (PF.deviceID fs, PF.fileID fs)
@@ -242,13 +274,6 @@ canOpenDirectory fp =
return True return True
-- |Throws a `Can'tOpenDirectory` FmIOException if the directory at the given
-- path cannot be opened.
throwCantOpenDirectory :: Path Abs -> IO ()
throwCantOpenDirectory fp =
unlessM (canOpenDirectory fp)
(throwIO . Can'tOpenDirectory . fromAbs $ fp)
-------------------------------- --------------------------------
@@ -308,8 +333,8 @@ bracketeer before after afterEx thing =
reactOnError :: IO a reactOnError :: IO a
-> [(IOErrorType, IO a)] -- ^ reaction on IO errors -> [(IOErrorType, IO a)] -- ^ reaction on IO errors
-> [(HPathIOException, IO a)] -- ^ reaction on FmIOException -> [(HPathIOException, IO a)] -- ^ reaction on HPathIOException
-> IO a -> IO a
reactOnError a ios fmios = reactOnError a ios fmios =
a `catches` [iohandler, fmiohandler] a `catches` [iohandler, fmiohandler]
@@ -328,3 +353,4 @@ reactOnError a ios fmios =
else y) else y)
(throwIO ex) (throwIO ex)
fmios fmios

View File

@@ -1,32 +0,0 @@
-- |
-- Module : HPath.IO.Utils
-- Copyright : © 2016 Julian Ospald
-- License : GPL-2
--
-- Maintainer : Julian Ospald <hasufell@posteo.de>
-- Stability : experimental
-- Portability : portable
--
-- Random and general IO/monad utilities.
module HPath.IO.Utils where
import Control.Monad
(
when
, unless
)
-- |If the value of the first argument is True, then execute the action
-- provided in the second argument, otherwise do nothing.
whenM :: Monad m => m Bool -> m () -> m ()
whenM mb a = mb >>= (`when` a)
-- |If the value of the first argument is False, then execute the action
-- provided in the second argument, otherwise do nothing.
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM mb a = mb >>= (`unless` a)

View File

@@ -3,8 +3,7 @@
-- | Internal types and functions. -- | Internal types and functions.
module HPath.Internal module HPath.Internal
(Path(..) (Path(..))
,RelC)
where where
import Control.DeepSeq (NFData (..)) import Control.DeepSeq (NFData (..))
@@ -13,7 +12,7 @@ import Data.Data
-- | Path of some base and type. -- | 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@ -- 1. without trailing path separator: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@
-- 2. with trailing path separator: @foo\/@, @\/foo\/bar\/@ -- 2. with trailing path separator: @foo\/@, @\/foo\/bar\/@
@@ -23,7 +22,7 @@ import Data.Data
data Path b = MkPath ByteString data Path b = MkPath ByteString
deriving (Typeable) deriving (Typeable)
-- | String equality. -- | ByteString equality.
-- --
-- The following property holds: -- The following property holds:
-- --
@@ -31,7 +30,7 @@ data Path b = MkPath ByteString
instance Eq (Path b) where instance Eq (Path b) where
(==) (MkPath x) (MkPath y) = x == y (==) (MkPath x) (MkPath y) = x == y
-- | String ordering. -- | ByteString ordering.
-- --
-- The following property holds: -- The following property holds:
-- --
@@ -39,7 +38,7 @@ instance Eq (Path b) where
instance Ord (Path b) where instance Ord (Path b) where
compare (MkPath x) (MkPath y) = compare x y compare (MkPath x) (MkPath y) = compare x y
-- | Same as 'Path.toFilePath'. -- | Same as 'HPath.toFilePath'.
-- --
-- The following property holds: -- The following property holds:
-- --
@@ -50,6 +49,3 @@ instance Show (Path b) where
instance NFData (Path b) where instance NFData (Path b) where
rnf (MkPath x) = rnf x 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 ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wall #-}
module System.Posix.Directory.Traversals ( module System.Posix.Directory.Traversals (
getDirectoryContents getDirectoryContents
@@ -17,12 +33,15 @@ module System.Posix.Directory.Traversals (
, readDirEnt , readDirEnt
, packDirStream , packDirStream
, unpackDirStream , unpackDirStream
, openFd , fdOpendir
, realpath , realpath
) where ) where
import Control.Applicative
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad import Control.Monad
import System.Posix.FilePath ((</>)) import System.Posix.FilePath ((</>))
import System.Posix.Directory.Foreign import System.Posix.Directory.Foreign
@@ -36,6 +55,7 @@ import System.Posix.Directory.ByteString as PosixBS
import System.Posix.Files.ByteString import System.Posix.Files.ByteString
import System.IO.Unsafe import System.IO.Unsafe
import "unix" System.Posix.IO.ByteString (closeFd)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Foreign.C.Error import Foreign.C.Error
import Foreign.C.String import Foreign.C.String
@@ -54,6 +74,8 @@ import Foreign.Storable
-- Upon entering a directory, 'allDirectoryContents' will get all entries -- Upon entering a directory, 'allDirectoryContents' will get all entries
-- strictly. However the returned list is lazy in that directories will only -- strictly. However the returned list is lazy in that directories will only
-- be accessed on demand. -- be accessed on demand.
--
-- Follows symbolic links for the input dir.
allDirectoryContents :: RawFilePath -> IO [RawFilePath] allDirectoryContents :: RawFilePath -> IO [RawFilePath]
allDirectoryContents topdir = do allDirectoryContents topdir = do
namesAndTypes <- getDirectoryContents topdir namesAndTypes <- getDirectoryContents topdir
@@ -71,6 +93,8 @@ allDirectoryContents topdir = do
return (topdir : concat paths) return (topdir : concat paths)
-- | Get all files from a directory and its subdirectories strictly. -- | Get all files from a directory and its subdirectories strictly.
--
-- Follows symbolic links for the input dir.
allDirectoryContents' :: RawFilePath -> IO [RawFilePath] allDirectoryContents' :: RawFilePath -> IO [RawFilePath]
allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) [] allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) []
-- this uses traverseDirectory because it's more efficient than forcing the -- 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. -- files/subdirectories.
-- --
-- This function allows for memory-efficient traversals. -- This function allows for memory-efficient traversals.
--
-- Follows symbolic links for the input dir.
traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s
traverseDirectory act s0 topdir = toploop traverseDirectory act s0 topdir = toploop
where where
@@ -103,17 +129,17 @@ actOnDirContents :: RawFilePath
-> IO b -> IO b
actOnDirContents pathRelToTop b f = actOnDirContents pathRelToTop b f =
modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) . modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .
(`ioeSetLocation` "findBSTypRel")) $ do (`ioeSetLocation` "findBSTypRel")) $
bracket bracket
(openDirStream pathRelToTop) (openDirStream pathRelToTop)
(Posix.closeDirStream) Posix.closeDirStream
(\dirp -> loop dirp b) (\dirp -> loop dirp b)
where where
loop dirp b' = do loop dirp b' = do
(typ,e) <- readDirEnt dirp (typ,e) <- readDirEnt dirp
if (e == "") if (e == "")
then return b' then return b'
else do else
if (e == "." || e == "..") if (e == "." || e == "..")
then loop dirp b' then loop dirp b'
else f typ (pathRelToTop </> e) b' >>= loop dirp else f typ (pathRelToTop </> e) b' >>= loop dirp
@@ -154,9 +180,6 @@ foreign import ccall "realpath"
foreign import ccall unsafe "fdopendir" foreign import ccall unsafe "fdopendir"
c_fdopendir :: Posix.Fd -> IO (Ptr ()) 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 -- less dodgy but still lower-level
@@ -189,81 +212,53 @@ readDirEnt (unpackDirStream -> dirp) =
else throwErrno "readDirEnt" else throwErrno "readDirEnt"
-- |Gets all directory contents (not recursively).
getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)] getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]
getDirectoryContents path = getDirectoryContents path =
modifyIOError ((`ioeSetFileName` (BS.unpack path)) . modifyIOError ((`ioeSetFileName` (BS.unpack path)) .
(`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ do (`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $
bracket bracket
(PosixBS.openDirStream path) (PosixBS.openDirStream path)
PosixBS.closeDirStream PosixBS.closeDirStream
loop _dirloop
where
loop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- loop dirp
return (t:es)
-- |Binding to @fdopendir(3)@.
fdOpendir :: Posix.Fd -> IO DirStream fdOpendir :: Posix.Fd -> IO DirStream
fdOpendir fd = fdOpendir fd =
packDirStream <$> throwErrnoIfNull "fdOpendir" (c_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' :: Posix.Fd -> IO [(DirType, RawFilePath)]
getDirectoryContents' fd = getDirectoryContents' fd = do
bracket dirstream <- fdOpendir fd `catchIOError` \e -> do
(fdOpendir fd) closeFd fd
PosixBS.closeDirStream ioError e
loop -- closeDirStream closes the filedescriptor
where finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream)
loop dirp = do
t@(_typ,e) <- readDirEnt dirp
if BS.null e then return [] else do
es <- loop dirp
return (t:es)
open_ :: CString _dirloop :: DirStream -> IO [(DirType, RawFilePath)]
-> Posix.OpenMode {-# INLINE _dirloop #-}
-> [Flags] _dirloop dirp = do
-> Maybe Posix.FileMode t@(_typ,e) <- readDirEnt dirp
-> IO Posix.Fd if BS.null e then return [] else do
open_ str how optional_flags maybe_mode = do es <- _dirloop dirp
fd <- c_open str all_flags mode_w return (t:es)
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
-- | return the canonicalized absolute pathname -- | return the canonicalized absolute pathname
-- --
-- like canonicalizePath, but uses realpath(3) -- like canonicalizePath, but uses @realpath(3)@
realpath :: RawFilePath -> IO RawFilePath realpath :: RawFilePath -> IO RawFilePath
realpath inp = do realpath inp =
allocaBytes pathMax $ \tmp -> do allocaBytes pathMax $ \tmp -> do
void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp
BS.packCString 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! -- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-} {-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -Wall #-}
@@ -18,7 +20,7 @@
module System.Posix.FilePath ( module System.Posix.FilePath (
-- * Separators -- * Separator predicates
pathSeparator pathSeparator
, isPathSeparator , isPathSeparator
, searchPathSeparator , searchPathSeparator
@@ -26,7 +28,11 @@ module System.Posix.FilePath (
, extSeparator , extSeparator
, isExtSeparator , isExtSeparator
-- * File extensions -- * $PATH methods
, splitSearchPath
, getSearchPath
-- * Extension functions
, splitExtension , splitExtension
, takeExtension , takeExtension
, replaceExtension , replaceExtension
@@ -37,8 +43,9 @@ module System.Posix.FilePath (
, splitExtensions , splitExtensions
, dropExtensions , dropExtensions
, takeExtensions , takeExtensions
, stripExtension
-- * Filenames/Directory names -- * Filename\/directory functions
, splitFileName , splitFileName
, takeFileName , takeFileName
, replaceFileName , replaceFileName
@@ -47,92 +54,135 @@ module System.Posix.FilePath (
, replaceBaseName , replaceBaseName
, takeDirectory , takeDirectory
, replaceDirectory , replaceDirectory
-- * Path combinators and splitters
, combine , combine
, (</>) , (</>)
, splitPath , splitPath
, joinPath , joinPath
, splitDirectories , splitDirectories
-- * Path conversions -- * Trailing slash functions
, normalise
-- * Trailing path separator
, hasTrailingPathSeparator , hasTrailingPathSeparator
, addTrailingPathSeparator , addTrailingPathSeparator
, dropTrailingPathSeparator , dropTrailingPathSeparator
-- * Queries -- * File name manipulations
, normalise
, makeRelative
, equalFilePath
, isRelative , isRelative
, isAbsolute , isAbsolute
, isValid , isValid
, makeValid
, isFileName , isFileName
, hasParentDir , hasParentDir
, equalFilePath
, hiddenFile , hiddenFile
-- * Type conversion
, fpToString
, userStringToFP
, module System.Posix.ByteString.FilePath , module System.Posix.ByteString.FilePath
) where ) where
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (fromString, toString) import Data.String (fromString)
import System.Posix.ByteString.FilePath import System.Posix.ByteString.FilePath
import qualified System.Posix.Env.ByteString as PE
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Word8 import Data.Word8
#if !MIN_VERSION_bytestring(0,10,8)
import qualified Data.List as L
#endif
import Control.Arrow (second) import Control.Arrow (second)
-- $setup -- $setup
-- >>> import Data.Char -- >>> import Data.Char
-- >>> import Data.Maybe
-- >>> import Test.QuickCheck -- >>> import Test.QuickCheck
-- >>> import Control.Applicative -- >>> import Control.Applicative
-- >>> import qualified Data.ByteString as BS -- >>> import qualified Data.ByteString as BS
-- >>> import Data.ByteString (ByteString)
-- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary -- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary
-- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack -- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack
-- --
-- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral -- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral
------------------------
-- Separator predicates
-- | Path separator character -- | Path separator character
pathSeparator :: Word8 pathSeparator :: Word8
pathSeparator = _slash pathSeparator = _slash
-- | Check if a character is the path separator -- | Check if a character is the path separator
-- --
-- prop> \n -> (_chr n == '/') == isPathSeparator n -- prop> \n -> (_chr n == '/') == isPathSeparator n
isPathSeparator :: Word8 -> Bool isPathSeparator :: Word8 -> Bool
isPathSeparator = (== pathSeparator) isPathSeparator = (== pathSeparator)
-- | Search path separator -- | Search path separator
searchPathSeparator :: Word8 searchPathSeparator :: Word8
searchPathSeparator = _colon searchPathSeparator = _colon
-- | Check if a character is the search path separator -- | Check if a character is the search path separator
-- --
-- prop> \n -> (_chr n == ':') == isSearchPathSeparator n -- prop> \n -> (_chr n == ':') == isSearchPathSeparator n
isSearchPathSeparator :: Word8 -> Bool isSearchPathSeparator :: Word8 -> Bool
isSearchPathSeparator = (== searchPathSeparator) isSearchPathSeparator = (== searchPathSeparator)
-- | File extension separator -- | File extension separator
extSeparator :: Word8 extSeparator :: Word8
extSeparator = _period extSeparator = _period
-- | Check if a character is the file extension separator -- | Check if a character is the file extension separator
-- --
-- prop> \n -> (_chr n == '.') == isExtSeparator n -- prop> \n -> (_chr n == '.') == isExtSeparator n
isExtSeparator :: Word8 -> Bool isExtSeparator :: Word8 -> Bool
isExtSeparator = (== extSeparator) 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 -- | Split a 'RawFilePath' into a path+filename and extension
-- --
@@ -152,6 +202,7 @@ splitExtension x = if BS.null basename
(path,file) = splitFileNameRaw x (path,file) = splitFileNameRaw x
(basename,fileExt) = BS.breakEnd isExtSeparator file (basename,fileExt) = BS.breakEnd isExtSeparator file
-- | Get the final extension from a 'RawFilePath' -- | Get the final extension from a 'RawFilePath'
-- --
-- >>> takeExtension "file.exe" -- >>> takeExtension "file.exe"
@@ -163,12 +214,14 @@ splitExtension x = if BS.null basename
takeExtension :: RawFilePath -> ByteString takeExtension :: RawFilePath -> ByteString
takeExtension = snd . splitExtension takeExtension = snd . splitExtension
-- | Change a file's extension -- | Change a file's extension
-- --
-- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path -- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path
replaceExtension :: RawFilePath -> ByteString -> RawFilePath replaceExtension :: RawFilePath -> ByteString -> RawFilePath
replaceExtension path ext = dropExtension path <.> ext replaceExtension path ext = dropExtension path <.> ext
-- | Drop the final extension from a 'RawFilePath' -- | Drop the final extension from a 'RawFilePath'
-- --
-- >>> dropExtension "file.exe" -- >>> dropExtension "file.exe"
@@ -180,6 +233,7 @@ replaceExtension path ext = dropExtension path <.> ext
dropExtension :: RawFilePath -> RawFilePath dropExtension :: RawFilePath -> RawFilePath
dropExtension = fst . splitExtension dropExtension = fst . splitExtension
-- | Add an extension to a 'RawFilePath' -- | Add an extension to a 'RawFilePath'
-- --
-- >>> addExtension "file" ".exe" -- >>> addExtension "file" ".exe"
@@ -195,10 +249,6 @@ addExtension file ext
| otherwise = BS.intercalate (BS.singleton extSeparator) [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 -- | Check if a 'RawFilePath' has an extension
-- --
-- >>> hasExtension "file" -- >>> hasExtension "file"
@@ -210,7 +260,13 @@ addExtension file ext
hasExtension :: RawFilePath -> Bool hasExtension :: RawFilePath -> Bool
hasExtension = isJust . BS.elemIndex extSeparator . takeFileName 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" -- >>> splitExtensions "/path/file.tar.gz"
-- ("/path/file",".tar.gz") -- ("/path/file",".tar.gz")
@@ -224,6 +280,7 @@ splitExtensions x = if BS.null basename
(path,file) = splitFileNameRaw x (path,file) = splitFileNameRaw x
(basename,fileExt) = BS.break isExtSeparator file (basename,fileExt) = BS.break isExtSeparator file
-- | Remove all extensions from a 'RawFilePath' -- | Remove all extensions from a 'RawFilePath'
-- --
-- >>> dropExtensions "/path/file.tar.gz" -- >>> dropExtensions "/path/file.tar.gz"
@@ -231,6 +288,7 @@ splitExtensions x = if BS.null basename
dropExtensions :: RawFilePath -> RawFilePath dropExtensions :: RawFilePath -> RawFilePath
dropExtensions = fst . splitExtensions dropExtensions = fst . splitExtensions
-- | Take all extensions from a 'RawFilePath' -- | Take all extensions from a 'RawFilePath'
-- --
-- >>> takeExtensions "/path/file.tar.gz" -- >>> takeExtensions "/path/file.tar.gz"
@@ -238,8 +296,48 @@ dropExtensions = fst . splitExtensions
takeExtensions :: RawFilePath -> ByteString takeExtensions :: RawFilePath -> ByteString
takeExtensions = snd . splitExtensions 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 -- | Split a 'RawFilePath' into (path,file). 'combine' is the inverse
-- --
@@ -269,12 +367,14 @@ splitFileName x = if BS.null path
takeFileName :: RawFilePath -> RawFilePath takeFileName :: RawFilePath -> RawFilePath
takeFileName = snd . splitFileName takeFileName = snd . splitFileName
-- | Change the file name -- | Change the file name
-- --
-- prop> \path -> replaceFileName path (takeFileName path) == path -- prop> \path -> replaceFileName path (takeFileName path) == path
replaceFileName :: RawFilePath -> ByteString -> RawFilePath replaceFileName :: RawFilePath -> ByteString -> RawFilePath
replaceFileName x y = fst (splitFileNameRaw x) </> y replaceFileName x y = fst (splitFileNameRaw x) </> y
-- | Drop the file name -- | Drop the file name
-- --
-- >>> dropFileName "path/file.txt" -- >>> dropFileName "path/file.txt"
@@ -284,6 +384,7 @@ replaceFileName x y = fst (splitFileNameRaw x) </> y
dropFileName :: RawFilePath -> RawFilePath dropFileName :: RawFilePath -> RawFilePath
dropFileName = fst . splitFileName dropFileName = fst . splitFileName
-- | Get the file name, without a trailing extension -- | Get the file name, without a trailing extension
-- --
-- >>> takeBaseName "path/file.tar.gz" -- >>> takeBaseName "path/file.tar.gz"
@@ -293,6 +394,7 @@ dropFileName = fst . splitFileName
takeBaseName :: RawFilePath -> ByteString takeBaseName :: RawFilePath -> ByteString
takeBaseName = dropExtension . takeFileName takeBaseName = dropExtension . takeFileName
-- | Change the base name -- | Change the base name
-- --
-- >>> replaceBaseName "path/file.tar.gz" "bob" -- >>> replaceBaseName "path/file.tar.gz" "bob"
@@ -305,6 +407,7 @@ replaceBaseName path name = combineRaw dir (name <.> ext)
(dir,file) = splitFileNameRaw path (dir,file) = splitFileNameRaw path
ext = takeExtension file ext = takeExtension file
-- | Get the directory, moving up one level if it's already a directory -- | Get the directory, moving up one level if it's already a directory
-- --
-- >>> takeDirectory "path/file.txt" -- >>> takeDirectory "path/file.txt"
@@ -324,12 +427,14 @@ takeDirectory x = case () of
res = fst $ BS.spanEnd isPathSeparator file res = fst $ BS.spanEnd isPathSeparator file
file = dropFileName x file = dropFileName x
-- | Change the directory component of a 'RawFilePath' -- | Change the directory component of a 'RawFilePath'
-- --
-- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "." -- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "."
replaceDirectory :: RawFilePath -> ByteString -> RawFilePath replaceDirectory :: RawFilePath -> ByteString -> RawFilePath
replaceDirectory file dir = combineRaw dir (takeFileName file) replaceDirectory file dir = combineRaw dir (takeFileName file)
-- | Join two paths together -- | Join two paths together
-- --
-- >>> combine "/" "file" -- >>> combine "/" "file"
@@ -342,6 +447,7 @@ combine :: RawFilePath -> RawFilePath -> RawFilePath
combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b
| otherwise = combineRaw a b | otherwise = combineRaw a b
-- | Operator version of combine -- | Operator version of combine
(</>) :: RawFilePath -> RawFilePath -> RawFilePath (</>) :: RawFilePath -> RawFilePath -> RawFilePath
(</>) = combine (</>) = combine
@@ -363,6 +469,17 @@ splitPath = splitter
Nothing -> [x] Nothing -> [x]
Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) 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 -- | Like 'splitPath', but without trailing slashes
-- --
-- >>> splitDirectories "/path/to/file.txt" -- >>> splitDirectories "/path/to/file.txt"
@@ -378,14 +495,60 @@ splitDirectories x
where where
splitter = filter (not . BS.null) . BS.split pathSeparator 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"] -- >>> addTrailingPathSeparator "/path"
-- "path/to/file.txt" -- "/path/"
joinPath :: [RawFilePath] -> RawFilePath -- >>> addTrailingPathSeparator "/path/"
joinPath = foldr (</>) BS.empty -- "/path/"
-- >>> addTrailingPathSeparator "/"
-- "/"
addTrailingPathSeparator :: RawFilePath -> RawFilePath
addTrailingPathSeparator x = if hasTrailingPathSeparator x
then x
else x `BS.snoc` pathSeparator
-- | Remove a trailing path separator
--
-- >>> dropTrailingPathSeparator "/path/"
-- "/path"
-- >>> dropTrailingPathSeparator "/path////"
-- "/path"
-- >>> dropTrailingPathSeparator "/"
-- "/"
-- >>> dropTrailingPathSeparator "//"
-- "/"
dropTrailingPathSeparator :: RawFilePath -> RawFilePath
dropTrailingPathSeparator x
| x == BS.singleton pathSeparator = x
| otherwise = if hasTrailingPathSeparator x
then dropTrailingPathSeparator $ BS.init x
else x
------------------------
-- File name manipulations
-- |Normalise a file. -- |Normalise a file.
@@ -442,139 +605,47 @@ normalise filepath =
dropDots = filter (BS.singleton _period /=) 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/" -- >>> makeRelative "/directory" "/directory/file.ext"
-- True -- "file.ext"
-- >>> hasTrailingPathSeparator "/" -- >>> makeRelative "/Home" "/home/bob"
-- True -- "/home/bob"
-- >>> hasTrailingPathSeparator "/path" -- >>> makeRelative "/home/" "/home/bob/foo/bar"
-- False -- "bob/foo/bar"
hasTrailingPathSeparator :: RawFilePath -> Bool -- >>> makeRelative "/fred" "bob"
hasTrailingPathSeparator x -- "bob"
| BS.null x = False -- >>> makeRelative "/file/test" "/file/test/fred"
| otherwise = isPathSeparator $ BS.last x -- "fred"
-- >>> makeRelative "/file/test" "/file/test/fred/"
-- | Add a trailing path separator. -- "fred/"
-- >>> makeRelative "some/path" "some/path/a/b/c"
-- "a/b/c"
-- --
-- >>> addTrailingPathSeparator "/path" -- prop> \p -> makeRelative p p == "."
-- "/path/" -- prop> \p -> makeRelative (takeDirectory p) p `equalFilePath` takeFileName p
-- >>> addTrailingPathSeparator "/path/" -- prop \x y -> equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
-- "/path/" makeRelative :: RawFilePath -> RawFilePath -> RawFilePath
-- >>> addTrailingPathSeparator "/" makeRelative root path
-- "/" | equalFilePath root path = BS.singleton _period
addTrailingPathSeparator :: RawFilePath -> RawFilePath | takeAbs root /= takeAbs path = path
addTrailingPathSeparator x = if hasTrailingPathSeparator x | otherwise = f (dropAbs root) (dropAbs path)
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
)
where 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 -- |Equality of two filepaths. The filepaths are normalised
-- and trailing path separators are dropped. -- and trailing path separators are dropped.
@@ -585,6 +656,8 @@ hasParentDir filepath =
-- True -- True
-- >>> equalFilePath "foo" "./foo" -- >>> equalFilePath "foo" "./foo"
-- True -- True
-- >>> equalFilePath "" ""
-- True
-- >>> equalFilePath "foo" "/foo" -- >>> equalFilePath "foo" "/foo"
-- False -- False
-- >>> equalFilePath "foo" "FOO" -- >>> equalFilePath "foo" "FOO"
@@ -599,37 +672,138 @@ equalFilePath p1 p2 = f p1 == f p2
f x = dropTrailingPathSeparator $ normalise x 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. -- | Whether the file is a hidden file.
-- --
-- >>> hiddenFile ".foo" -- >>> hiddenFile ".foo"
-- True -- True
-- >>> hiddenFile "..foo.bar" -- >>> hiddenFile "..foo.bar"
-- True -- True
-- >>> hiddenFile "some/path/.bar"
-- True
-- >>> hiddenFile "..." -- >>> hiddenFile "..."
-- True -- True
-- >>> hiddenFile "dod"
-- False
-- >>> hiddenFile "dod.bar" -- >>> hiddenFile "dod.bar"
-- False -- False
-- >>> hiddenFile "."
-- False
-- >>> hiddenFile ".."
-- False
-- >>> hiddenFile ""
-- False
hiddenFile :: RawFilePath -> Bool hiddenFile :: RawFilePath -> Bool
hiddenFile fp hiddenFile fp
| fp == BS.pack [_period, _period] = False | fn == BS.pack [_period, _period] = False
| fp == BS.pack [_period] = False | fn == BS.pack [_period] = False
| otherwise = BS.pack [extSeparator] | 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 -- Just split the input FileName without adding/normalizing or changing
-- anything. -- anything.
splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath) splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw x = BS.breakEnd isPathSeparator x splitFileNameRaw = BS.breakEnd isPathSeparator
-- | Combine two paths, assuming rhs is NOT absolute. -- | Combine two paths, assuming rhs is NOT absolute.
combineRaw :: RawFilePath -> RawFilePath -> RawFilePath combineRaw :: RawFilePath -> RawFilePath -> RawFilePath

View File

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

View File

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

View File

@@ -0,0 +1,247 @@
{-# 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 (\(h, e) -> ioeGetErrorType e == InappropriateType
&& isCopyFileFailed h) ex &&
any (\(h, e) -> ioeGetErrorType e == PermissionDenied
&& isReadContentsFailed h) ex)
normalDirPerms "outputDir1/foo2/foo4"
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
c <- allDirectoryContents' "outputDir1"
tmpDir' <- getRawTmpDir
let shouldC = (fmap (\x -> tmpDir' `BS.append` x)
["outputDir1"
,"outputDir1/foo2"
,"outputDir1/foo2/inputFile1"
,"outputDir1/foo2/inputFile2"
,"outputDir1/foo2/inputFile3"
,"outputDir1/foo2/foo4"
,"outputDir1/foo2/foo4/inputFile6"
,"outputDir1/foo2/foo4/inputFile4"])
deleteFile' "outputDir1/foo2/inputFile1"
deleteFile' "outputDir1/foo2/inputFile2"
deleteFile' "outputDir1/foo2/inputFile3"
sort c `shouldBe` sort shouldC
it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $
copyDirRecursive' "inputDir"
"noWritePerm/foo"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $
copyDirRecursive' "inputDir"
"noPerms/foo"
Strict
CollectFailures
`shouldThrow`
isRecursiveFailure
it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $
copyDirRecursive' "inputDir"
"alreadyExistsD"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $
copyDirRecursive' "inputDir"
"alreadyExists"
Strict
CollectFailures
`shouldThrow`
isRecursiveFailure
it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $
copyDirRecursive' "wrongInput"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument)
it "copyDirRecursive (Strict, CollectFailures), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Strict
CollectFailures
`shouldThrow`
isDestinationInSource
it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Strict
CollectFailures
`shouldThrow`
isSameFile

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -0,0 +1,71 @@
{-# 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, parent directories do not exist" $
createSymlink' "some/thing/dada" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createSymlink, can't write to destination directory" $
createSymlink' "noWritePerms/newDir" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createSymlink, can't write to destination directory" $
createSymlink' "noPerms/newDir" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createSymlink, destination file already exists" $
createSymlink' "alreadyExists" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -1 +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

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