packages feed

hpath (empty) → 0.5.9

raw patch · 36 files changed

+4845/−0 lines, 36 filesdep +HUnitdep +QuickCheckdep +basesetup-changed

Dependencies added: HUnit, QuickCheck, base, bytestring, criterion, deepseq, directory, doctest, exceptions, filepath, hpath, hspec, process, unix, unix-bytestring, utf8-string, word8

Files

+ CHANGELOG view
@@ -0,0 +1,35 @@+0.5.9:+	* Adds our posix-paths fork and a lot of IO operations.+0.5.8:+	* First version of the fork.+0.5.7:+	* Fix haddock problem.+0.5.6:+	* Reject only .. and .+0.5.5:+	* Use filepath's isValid function for additional sanity checks+0.5.4:+	* Disable parsing of path consisting only of "."+	* Add NFData instance for Path+	* Some typo/docs improvements+	* Add standard headers to modules+0.5.3:+	* Added conversion functions.++0.2.0:++        * Rename parentAbs to simply parent.+	* Add dirname.++0.3.0:+	* Removed Generic instance.++0.4.0:+	* Implemented stricter parsing, disabling use of "..".+	* Made stripDir generic over MonadThrow++0.5.0:+	* Fix stripDir p p /= Nothing bug.++0.5.2:+	* Removed unused DeriveGeneric.
+ LICENSE view
@@ -0,0 +1,340 @@+             GNU GENERAL PUBLIC LICENSE+                Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++                     Preamble++  The licenses for most software are designed to take away your+freedom to share and change it.  By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users.  This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it.  (Some other Free Software Foundation software is covered by+the GNU Lesser General Public License instead.)  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++  To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have.  You must make sure that they, too, receive or can get the+source code.  And you must show them these terms so they know their+rights.++  We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++  Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software.  If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++  Finally, any free program is threatened constantly by software+patents.  We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary.  To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++  The precise terms and conditions for copying, distribution and+modification follow.++             GNU GENERAL PUBLIC LICENSE+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++  0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License.  The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language.  (Hereinafter, translation is included without limitation in+the term "modification".)  Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope.  The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++  1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++  2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++    a) You must cause the modified files to carry prominent notices+    stating that you changed the files and the date of any change.++    b) You must cause any work that you distribute or publish, that in+    whole or in part contains or is derived from the Program or any+    part thereof, to be licensed as a whole at no charge to all third+    parties under the terms of this License.++    c) If the modified program normally reads commands interactively+    when run, you must cause it, when started running for such+    interactive use in the most ordinary way, to print or display an+    announcement including an appropriate copyright notice and a+    notice that there is no warranty (or else, saying that you provide+    a warranty) and that users may redistribute the program under+    these conditions, and telling the user how to view a copy of this+    License.  (Exception: if the Program itself is interactive but+    does not normally print such an announcement, your work based on+    the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole.  If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works.  But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++  3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++    a) Accompany it with the complete corresponding machine-readable+    source code, which must be distributed under the terms of Sections+    1 and 2 above on a medium customarily used for software interchange; or,++    b) Accompany it with a written offer, valid for at least three+    years, to give any third party, for a charge no more than your+    cost of physically performing source distribution, a complete+    machine-readable copy of the corresponding source code, to be+    distributed under the terms of Sections 1 and 2 above on a medium+    customarily used for software interchange; or,++    c) Accompany it with the information you received as to the offer+    to distribute corresponding source code.  (This alternative is+    allowed only for noncommercial distribution and only if you+    received the program in object code or executable form with such+    an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it.  For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable.  However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++  4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License.  Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++  5. You are not required to accept this License, since you have not+signed it.  However, nothing else grants you permission to modify or+distribute the Program or its derivative works.  These actions are+prohibited by law if you do not accept this License.  Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++  6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions.  You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++  7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all.  For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices.  Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++  8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded.  In such case, this License incorporates+the limitation as if written in the body of this License.++  9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number.  If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation.  If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++  10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission.  For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this.  Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++                     NO WARRANTY++  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++              END OF TERMS AND CONDITIONS++     How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License along+    with this program; if not, write to the Free Software Foundation, Inc.,+    51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++    Gnomovision version 69, Copyright (C) year name of author+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary.  Here is a sample; alter the names:++  Yoyodyne, Inc., hereby disclaims all copyright interest in the program+  `Gnomovision' (which makes passes at compilers) written by James Hacker.++  <signature of Ty Coon>, 1 April 1989+  Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs.  If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.+
+ README.md view
@@ -0,0 +1,51 @@+# HPath++[![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath)++Support for well-typed paths in Haskell. Also provides ByteString based filepath+manipulation.++## Motivation++The motivation came during development of+[hsfm](https://github.com/hasufell/hsfm)+which has a pretty strict File type, but lacks a strict Path type, e.g.+for user input.++The library that came closest to my needs was+[path](https://github.com/chrisdone/path),+but the API turned out to be oddly complicated for my use case, so I+decided to fork it.++Similarly, [posix-paths](https://github.com/JohnLato/posix-paths)+was exactly what I wanted for the low-level operations, but upstream seems dead,+so it is forked as well and merged into this library.++## Goals++* well-typed paths+* high-level API to file operations like recursive directory copy+* safe filepath manipulation, never using String as filepath, but ByteString+* still allowing sufficient control to interact with the underlying low-level calls++## 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...+* trailing path separators will be preserved if they exist, no messing with that+* uses safe ByteString for filepaths under the hood instead of unsafe String+* fixes broken [dirname](https://github.com/chrisdone/path/issues/18)+* renames dirname/filename to basename/dirname to match the POSIX shell functions+* introduces a new `Path Fn` for safe filename guarantees and a `RelC` class+* allows pattern matching via unidirectional PatternSynonym+* uses simple doctest for testing+* allows `~/` as relative path, because on posix level `~` is just a regular filename that does _NOT_ point to `$HOME`+* remove TH, it sucks++## Differences to 'posix-paths'++* `hasTrailingPathSeparator` behaves in the same way as `System.FilePath`+* `dropTrailingPathSeparator` behaves in the same way as `System.FilePath`+* added various functions like `isValid`, `normalise` and `equalFilePath`+* uses the `word8` package for save word8 literals instead of `OverloadedStrings`+* has custom versions of `openFd` and `getDirectoryContents`+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/Bench.hs view
@@ -0,0 +1,90 @@+{-# 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)+    ]
+ cbits/dirutils.c view
@@ -0,0 +1,7 @@+#include "dirutils.h"+unsigned int+    __posixdir_d_type(struct dirent* d)+    {+      return(d -> d_type);+    }+
+ cbits/dirutils.h view
@@ -0,0 +1,13 @@+#ifndef POSIXPATHS_CBITS_DIRUTILS_H+#define POSIXPATHS_CBITS_DIRUTILS_H++#include <stdlib.h>+#include <dirent.h>+#include <sys/types.h>+#include <sys/stat.h>+#include <fcntl.h>++extern unsigned int+    __posixdir_d_type(struct dirent* d)+    ;+#endif
+ doctests-hpath.hs view
@@ -0,0 +1,13 @@+module Main where+++import Test.DocTest+import Test.HUnit++main =+    doctest+      ["-isrc"+      , "-XOverloadedStrings"+      , "src/HPath.hs"+      ]+
+ doctests-posix.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Applicative+import System.Posix.Directory.Traversals++import Test.DocTest+import Test.HUnit++main = do+    doctest+      [ "-isrc"+      , "-XOverloadedStrings"+      , "System.Posix.FilePath"+      ]+    runTestTT unitTests+++unitTests :: Test+unitTests = test+    [ TestCase $ do+        r <- (==) <$> allDirectoryContents "." <*> allDirectoryContents' "."+        assertBool "allDirectoryContents == allDirectoryContents'" r+    ]
+ hpath.cabal view
@@ -0,0 +1,121 @@+name:                hpath+version:             0.5.9+synopsis:            Support for well-typed paths+description:         Support for well-typed paths, utilizing ByteString under the hood.+license:             GPL-2+license-file:        LICENSE+author:              Julian Ospald <hasufell@posteo.de>+maintainer:          Julian Ospald <hasufell@posteo.de>+copyright:           Julian Ospald 2016+category:            Filesystem+build-type:          Simple+cabal-version:       >=1.14+extra-source-files:  README.md+                     CHANGELOG+                     benchmarks/*.hs+                     cbits/dirutils.h+                     doctests-hpath.hs+                     doctests-posix.hs++library+  hs-source-dirs:    src/+  default-language:  Haskell2010+  ghc-options:       -Wall+  c-sources:         cbits/dirutils.c+  exposed-modules:   HPath,+                     HPath.IO,+                     HPath.IO.Errors,+                     HPath.IO.Utils,+                     HPath.Internal,+                     System.Posix.Directory.Foreign,+                     System.Posix.Directory.Traversals,+                     System.Posix.FilePath+  build-depends:     base >= 4.2 && <5+                   , bytestring >= 0.9.2.0+                   , deepseq+                   , exceptions+                   , hspec+                   , unix >= 2.5+                   , unix-bytestring+                   , utf8-string+                   , word8+++test-suite doctests-hpath+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  ghc-options:       -threaded+  main-is:           doctests-hpath.hs+  build-depends:     base+                   , HUnit+                   , QuickCheck+                   , doctest >= 0.8+                   , hpath++test-suite doctests-posix+  default-language:  Haskell2010+  type:              exitcode-stdio-1.0+  ghc-options:       -threaded+  main-is:           doctests-posix.hs+  build-depends:     base,+                     bytestring,+                     unix,+                     hpath,+                     doctest >= 0.8,+                     HUnit,+                     QuickCheck++test-suite spec+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  Hs-Source-Dirs:       test+  Main-Is:              Main.hs+  other-modules:+                        Spec+                        HPath.IO.CopyDirRecursiveSpec+                        HPath.IO.CopyDirRecursiveOverwriteSpec+                        HPath.IO.CopyFileSpec+                        HPath.IO.CopyFileOverwriteSpec+                        HPath.IO.CreateDirSpec+                        HPath.IO.CreateRegularFileSpec+                        HPath.IO.DeleteDirRecursiveSpec+                        HPath.IO.DeleteDirSpec+                        HPath.IO.DeleteFileSpec+                        HPath.IO.GetDirsFilesSpec+                        HPath.IO.GetFileTypeSpec+                        HPath.IO.MoveFileSpec+                        HPath.IO.MoveFileOverwriteSpec+                        HPath.IO.RecreateSymlinkSpec+                        HPath.IO.RenameFileSpec+                        Utils+  GHC-Options:          -Wall+  Build-Depends:        base+                      , HUnit+                      , bytestring+                      , hpath+                      , hspec >= 1.3+                      , process+                      , unix+                      , utf8-string++benchmark bench.hs+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  hs-source-dirs: benchmarks+  main-is:        Bench.hs++  build-depends:+      base,+      hpath,+      bytestring,+      unix,+      directory  >= 1.1 && < 1.3,+      filepath   >= 1.2 && < 1.4,+      process    >= 1.0 && < 1.3,+      criterion  >= 0.6 && < 0.9+  ghc-options: -O2++source-repository head+  type:     git+  location: https://github.com/hasufell/hpath+
+ src/HPath.hs view
@@ -0,0 +1,369 @@+-- |+-- Module      :  HPath+-- Copyright   :  © 2015–2016 FP Complete, 2016 Julian Ospald+-- License     :  BSD 3 clause+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- Support for well-typed paths.+++{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE PatternSynonyms #-}++module HPath+  (+  -- * Types+   Abs+  ,Path+  ,Rel+  ,Fn+  ,PathParseException+  ,PathException+  -- * PatternSynonyms/ViewPatterns+  ,pattern Path+   -- * Path Parsing+  ,parseAbs+  ,parseFn+  ,parseRel+  -- * Path Conversion+  ,fromAbs+  ,fromRel+  ,toFilePath+  -- * Path Operations+  ,(</>)+  ,basename+  ,dirname+  ,isParentOf+  ,getAllParents+  ,stripDir+  -- * Path IO helpers+  ,withAbsPath+  ,withRelPath+  ,withFnPath+  -- * ByteString operations+  ,fpToString+  ,userStringToFP+  )+  where++import           Control.Exception (Exception)+import           Control.Monad.Catch (MonadThrow(..))+#if MIN_VERSION_bytestring(0,10,8)+import           Data.ByteString(ByteString, stripPrefix)+#else+import           Data.ByteString(ByteString)+#endif+import qualified Data.ByteString as BS+import           Data.Data+import qualified Data.List as L+import           Data.Maybe+import           Data.Word8+import           HPath.Internal+import           System.Posix.FilePath hiding ((</>))+++--------------------------------------------------------------------------------+-- Types++-- | An absolute path.+data Abs deriving (Typeable)++-- | A relative path; one without a root.+data Rel deriving (Typeable)++-- | A filename, without any '/'.+data Fn deriving (Typeable)++-- | Exception when parsing a location.+data PathParseException+  = InvalidAbs ByteString+  | InvalidRel ByteString+  | InvalidFn ByteString+  | Couldn'tStripPrefixTPS ByteString ByteString+  deriving (Show,Typeable)+instance Exception PathParseException++data PathException = RootDirHasNoBasename+  deriving (Show,Typeable)+instance Exception PathException++instance RelC Rel+instance RelC Fn++--------------------------------------------------------------------------------+-- PatternSynonyms++pattern Path x <- (MkPath x)++--------------------------------------------------------------------------------+-- Path Parsers++++-- | Get a location for an absolute path. Produces a normalised path.+--+-- Throws: 'PathParseException'+--+-- >>> parseAbs "/abc" :: Maybe (Path Abs)+-- Just "/abc"+-- >>> parseAbs "/" :: Maybe (Path Abs)+-- Just "/"+-- >>> parseAbs "/abc/def" :: Maybe (Path Abs)+-- Just "/abc/def"+-- >>> parseAbs "/abc/def/.///" :: Maybe (Path Abs)+-- Just "/abc/def/"+-- >>> parseAbs "abc" :: Maybe (Path Abs)+-- Nothing+-- >>> parseAbs "" :: Maybe (Path Abs)+-- Nothing+-- >>> parseAbs "/abc/../foo" :: Maybe (Path Abs)+-- Nothing+parseAbs :: MonadThrow m+         => ByteString -> m (Path Abs)+parseAbs filepath =+  if isAbsolute filepath &&+     isValid filepath &&+     not (hasParentDir filepath)+     then return (MkPath $ normalise filepath)+     else throwM (InvalidAbs filepath)+++-- | Get a location for a relative path. Produces a normalised+-- path.+--+-- Note that @filepath@ may contain any number of @./@ but may not consist+-- solely of @./@.  It also may not contain a single @..@ anywhere.+--+-- Throws: 'PathParseException'+--+-- >>> parseRel "abc" :: Maybe (Path Rel)+-- Just "abc"+-- >>> parseRel "def/" :: Maybe (Path Rel)+-- Just "def/"+-- >>> parseRel "abc/def" :: Maybe (Path Rel)+-- Just "abc/def"+-- >>> parseRel "abc/def/." :: Maybe (Path Rel)+-- Just "abc/def/"+-- >>> parseRel "/abc" :: Maybe (Path Rel)+-- Nothing+-- >>> parseRel "" :: Maybe (Path Rel)+-- Nothing+-- >>> parseRel "abc/../foo" :: Maybe (Path Rel)+-- Nothing+-- >>> parseRel "." :: Maybe (Path Rel)+-- Nothing+-- >>> parseRel ".." :: Maybe (Path Rel)+-- Nothing+parseRel :: MonadThrow m+         => ByteString -> m (Path Rel)+parseRel filepath =+  if not (isAbsolute filepath) &&+     filepath /= BS.singleton _period &&+     filepath /= BS.pack [_period, _period] &&+     not (hasParentDir filepath) &&+     isValid filepath+     then return (MkPath $ normalise filepath)+     else throwM (InvalidRel filepath)+++-- | Parses a filename. Filenames must not contain slashes.+-- Excludes '.' and '..'.+--+-- Throws: 'PathParseException'+--+-- >>> parseFn "abc" :: Maybe (Path Fn)+-- Just "abc"+-- >>> parseFn "..." :: Maybe (Path Fn)+-- Just "..."+-- >>> parseFn "def/" :: Maybe (Path Fn)+-- Nothing+-- >>> parseFn "abc/def" :: Maybe (Path Fn)+-- Nothing+-- >>> parseFn "abc/def/." :: Maybe (Path Fn)+-- Nothing+-- >>> parseFn "/abc" :: Maybe (Path Fn)+-- Nothing+-- >>> parseFn "" :: Maybe (Path Fn)+-- Nothing+-- >>> parseFn "abc/../foo" :: Maybe (Path Fn)+-- Nothing+-- >>> parseFn "." :: Maybe (Path Fn)+-- Nothing+-- >>> parseFn ".." :: Maybe (Path Fn)+-- Nothing+parseFn :: MonadThrow m+        => ByteString -> m (Path Fn)+parseFn filepath =+  if isFileName filepath &&+     filepath /= BS.singleton _period &&+     filepath /= BS.pack [_period, _period] &&+     isValid filepath+     then return (MkPath filepath)+     else throwM (InvalidFn filepath)++++--------------------------------------------------------------------------------+-- Path Conversion++-- | Convert any Path to a ByteString type.+toFilePath :: Path b -> ByteString+toFilePath (MkPath l) = l++-- | Convert an absolute Path to a ByteString type.+fromAbs :: Path Abs -> ByteString+fromAbs = toFilePath++-- | Convert a relative Path to a ByteString type.+fromRel :: RelC r => Path r -> ByteString+fromRel = toFilePath++++--------------------------------------------------------------------------------+-- Path Operations++-- | Append two paths.+--+-- The second argument must always be a relative path, which ensures+-- that undefinable things like `"/abc" </> "/def"` cannot happen.+--+-- Technically, the first argument can be a path that points to a non-directory,+-- because this library is IO-agnostic and makes no assumptions about+-- file types.+--+-- >>> (MkPath "/") </> (MkPath "file" :: Path Rel)+-- "/file"+-- >>> (MkPath "/path/to") </> (MkPath "file" :: Path Rel)+-- "/path/to/file"+-- >>> (MkPath "/") </> (MkPath "file/lal" :: Path Rel)+-- "/file/lal"+-- >>> (MkPath "/") </> (MkPath "file/" :: Path Rel)+-- "/file/"+(</>) :: RelC r => Path b -> Path r -> Path b+(</>) (MkPath a) (MkPath b) = MkPath (a' `BS.append` b)+  where+    a' = if BS.last a == pathSeparator+         then a+         else addTrailingPathSeparator a++-- | Strip directory from path, making it relative to that directory.+-- Throws 'Couldn'tStripPrefixDir' if directory is not a parent of the path.+--+-- The bases must match.+--+-- >>> (MkPath "/lal/lad") `stripDir` (MkPath "/lal/lad/fad") :: Maybe (Path Rel)+-- Just "fad"+-- >>> (MkPath "lal/lad") `stripDir` (MkPath "lal/lad/fad") :: Maybe (Path Rel)+-- Just "fad"+-- >>> (MkPath "/") `stripDir` (MkPath "/") :: Maybe (Path Rel)+-- Nothing+-- >>> (MkPath "/lal/lad/fad") `stripDir` (MkPath "/lal/lad") :: Maybe (Path Rel)+-- Nothing+-- >>> (MkPath "fad") `stripDir` (MkPath "fad") :: Maybe (Path Rel)+-- Nothing+stripDir :: MonadThrow m+         => Path b -> Path b -> m (Path Rel)+stripDir (MkPath p) (MkPath l) =+  case stripPrefix p' l of+    Nothing -> throwM (Couldn'tStripPrefixTPS p' l)+    Just ok -> if BS.null ok+                 then throwM (Couldn'tStripPrefixTPS p' l)+                 else return (MkPath ok)+  where+    p' = addTrailingPathSeparator p++-- | Is p a parent of the given location? Implemented in terms of+-- 'stripDir'. The bases must match.+--+-- >>> (MkPath "/lal/lad") `isParentOf` (MkPath "/lal/lad/fad")+-- True+-- >>> (MkPath "lal/lad") `isParentOf` (MkPath "lal/lad/fad")+-- True+-- >>> (MkPath "/") `isParentOf` (MkPath "/")+-- False+-- >>> (MkPath "/lal/lad/fad") `isParentOf` (MkPath "/lal/lad")+-- False+-- >>> (MkPath "fad") `isParentOf` (MkPath "fad")+-- False+isParentOf :: Path b -> Path b -> Bool+isParentOf p l = isJust (stripDir p l :: Maybe (Path Rel))+++-- |Get all parents of a path.+--+-- >>> getAllParents (MkPath "/abs/def/dod")+-- ["/abs/def","/abs","/"]+-- >>> getAllParents (MkPath "/")+-- []+getAllParents :: Path Abs -> [Path Abs]+getAllParents (MkPath p)+  | np == BS.singleton pathSeparator = []+  | otherwise = dirname (MkPath np) : getAllParents (dirname $ MkPath np)+  where+    np = dropTrailingPathSeparator . normalise $ p+++-- | Extract the directory name of a path.+--+-- The following properties hold:+--+-- @dirname (p \<\/> a) == dirname p@+--+-- >>> dirname (MkPath "/abc/def/dod")+-- "/abc/def"+-- >>> dirname (MkPath "/")+-- "/"+dirname :: Path Abs -> Path Abs+dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)++-- | Extract the file part of a path.+--+--+-- The following properties hold:+--+-- @basename (p \<\/> a) == basename a@+--+-- Throws: `PathException` if given the root path "/"+--+-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)+-- Just "dod"+-- >>> basename (MkPath "/") :: Maybe (Path Fn)+-- Nothing+basename :: MonadThrow m => Path b -> m (Path Fn)+basename (MkPath l)+  | not (isAbsolute rl) = return $ MkPath rl+  | otherwise           = throwM RootDirHasNoBasename+  where+    rl = last . splitPath . dropTrailingPathSeparator $ l+++--------------------------------------------------------------------------------+-- Path IO helpers+++withAbsPath :: Path Abs -> (ByteString -> IO a) -> IO a+withAbsPath (MkPath p) action = action p+++withRelPath :: Path Rel -> (ByteString -> IO a) -> IO a+withRelPath (MkPath p) action = action p+++withFnPath :: Path Fn -> (ByteString -> IO a) -> IO a+withFnPath (MkPath p) action = action p+++------------------------+-- ByteString helpers++#if MIN_VERSION_bytestring(0,10,8)+#else+stripPrefix :: ByteString -> ByteString -> Maybe ByteString+stripPrefix a b = BS.pack `fmap` L.stripPrefix (BS.unpack a) (BS.unpack b)+#endif
+ src/HPath/IO.hs view
@@ -0,0 +1,819 @@+-- |+-- Module      :  HPath.IO+-- Copyright   :  © 2016 Julian Ospald+-- License     :  GPL-2+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- This module provides high-level IO related file operations like+-- copy, delete, move and so on. It only operates on /Path Abs/ which+-- guarantees us well-typed paths which are absolute.+--+-- Some functions are just path-safe wrappers around+-- unix functions, others have stricter exception handling+-- and some implement functionality that doesn't have a unix+-- counterpart (like `copyDirRecursive`).+--+-- Some of these operations are due to their nature __not atomic__, which+-- means they may do multiple syscalls which form one context. Some+-- of them also have to examine the filetypes explicitly before the+-- syscalls, so a reasonable decision can be made. That means+-- the result is undefined if another process changes that context+-- while the non-atomic operation is still happening. However, where+-- possible, as few syscalls as possible are used and the underlying+-- exception handling is kept.+--+-- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket`+-- are not explicitly supported right now. Calling any of these+-- functions on such a file may throw an exception.++{-# LANGUAGE PackageImports #-}+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO+  (+  -- * Types+    FileType(..)+  -- * File copying+  , copyDirRecursive+  , copyDirRecursiveOverwrite+  , recreateSymlink+  , copyFile+  , copyFileOverwrite+  , easyCopy+  , easyCopyOverwrite+  -- * File deletion+  , deleteFile+  , deleteDir+  , deleteDirRecursive+  , easyDelete+  -- * File opening+  , openFile+  , executeFile+  -- * File creation+  , createRegularFile+  , createDir+  -- * File renaming/moving+  , renameFile+  , moveFile+  , moveFileOverwrite+  -- * File permissions+  , newFilePerms+  , newDirPerms+  -- * Directory reading+  , getDirsFiles+  -- * Filetype operations+  , getFileType+  -- * Others+  , canonicalizePath+  )+  where+++import Control.Applicative+  (+    (<$>)+  )+import Control.Exception+  (+    bracket+  , bracketOnError+  , throwIO+  )+import Control.Monad+  (+    void+  , when+  )+import Data.ByteString+  (+    ByteString+  )+import Data.Foldable+  (+    for_+  )+import Data.Maybe+  (+    catMaybes+  )+import Data.Word+  (+    Word8+  )+import Foreign.C.Error+  (+    eEXIST+  , eNOTEMPTY+  , eXDEV+  )+import Foreign.C.Types+  (+    CSize+  )+import Foreign.Marshal.Alloc+  (+    allocaBytes+  )+import Foreign.Ptr+  (+    Ptr+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import HPath+import HPath.Internal+import HPath.IO.Errors+import HPath.IO.Utils+import Prelude hiding (readFile)+import System.IO.Error+  (+    catchIOError+  , ioeGetErrorType+  )+import System.Posix.ByteString+  (+    exclusive+  )+import System.Posix.Directory.ByteString+  (+    createDirectory+  , removeDirectory+  )+import System.Posix.Directory.Traversals+  (+    getDirectoryContents'+  )+import System.Posix.Files.ByteString+  (+    createSymbolicLink+  , fileMode+  , getFdStatus+  , groupExecuteMode+  , groupReadMode+  , groupWriteMode+  , otherExecuteMode+  , otherReadMode+  , otherWriteMode+  , ownerModes+  , ownerReadMode+  , ownerWriteMode+  , readSymbolicLink+  , removeLink+  , rename+  , setFileMode+  , unionFileModes+  )+import qualified System.Posix.Files.ByteString as PF+import qualified "unix" System.Posix.IO.ByteString as SPI+import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB+import qualified System.Posix.Directory.Traversals as SPDT+import qualified System.Posix.Directory.Foreign as SPDF+import qualified System.Posix.Process.ByteString as SPP+import System.Posix.Types+  (+    FileMode+  , ProcessID+  , Fd+  )++++++data FileType = Directory+              | RegularFile+              | SymbolicLink+              | BlockDevice+              | CharacterDevice+              | NamedPipe+              | Socket+  deriving (Eq, Show)++++++    --------------------+    --[ File Copying ]--+    --------------------++++-- |Copies a directory recursively to the given destination.+-- Does not follow symbolic links.+--+-- Safety/reliability concerns:+--+--    * not atomic+--    * examines filetypes explicitly+--    * an explicit check `throwDestinationInSource` is carried out for the+--      top directory for basic sanity, because otherwise we might end up+--      with an infinite copy loop... however, this operation is not+--      carried out recursively (because it's slow)+--+-- Throws:+--+--    - `NoSuchThing` if source directory does not exist+--    - `PermissionDenied` if output directory is not writable+--    - `PermissionDenied` if source directory can't be opened+--    - `InvalidArgument` if source directory is wrong type (symlink)+--    - `InvalidArgument` if source directory is wrong type (regular file)+--    - `SameFile` if source and destination are the same file (`HPathIOException`)+--    - `AlreadyExists` if destination already exists+--    - `DestinationInSource` if destination is contained in source (`HPathIOException`)+copyDirRecursive :: Path Abs  -- ^ source dir+                 -> Path Abs  -- ^ full destination+                 -> IO ()+copyDirRecursive 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')+      createDirectory (fromAbs destdirp') fmode'++      for_ contents $ \f -> do+        ftype <- getFileType f+        newdest <- (destdirp' </>) <$> basename f+        case ftype of+          SymbolicLink -> recreateSymlink f newdest+          Directory    -> go f newdest+          RegularFile  -> copyFile f newdest+          _            -> ioError $ userError $ "No idea what to do with the" +++                                                "given filetype: " ++ show ftype+++-- |Like `copyDirRecursive` except it overwrites contents of directories+-- if any.+--+-- Throws:+--+--    - `NoSuchThing` if source directory does not exist+--    - `PermissionDenied` if output directory is not writable+--    - `PermissionDenied` if source directory can't be opened+--    - `InvalidArgument` if source directory is wrong type (symlink)+--    - `InvalidArgument` if source directory is wrong type (regular file)+--    - `SameFile` if source and destination are the same file (`HPathIOException`)+--    - `DestinationInSource` if destination is contained in source (`HPathIOException`)+copyDirRecursiveOverwrite :: Path Abs  -- ^ source dir+                          -> Path Abs  -- ^ full destination+                          -> IO ()+copyDirRecursiveOverwrite fromp destdirp+  = do+    -- for performance, sanity checks are only done for the top dir+    throwSameFile fromp destdirp+    throwDestinationInSource fromp destdirp+    go fromp destdirp+  where+    go :: Path Abs -> Path Abs -> IO ()+    go fromp' destdirp' = do+      -- order is important here, so we don't get empty directories+      -- on failure+      contents <- getDirsFiles fromp'++      fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')+      catchIOError (createDirectory (fromAbs destdirp') fmode') $ \e ->+        case ioeGetErrorType e of+          AlreadyExists -> setFileMode (fromAbs destdirp') fmode'+          _             -> ioError e++      for_ contents $ \f -> do+        ftype <- getFileType f+        newdest <- (destdirp' </>) <$> basename f+        case ftype of+          SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest)+                          >> recreateSymlink f newdest+          Directory    -> go f newdest+          RegularFile  -> copyFileOverwrite f newdest+          _            -> ioError $ userError $ "No idea what to do with the" +++                                                "given filetype: " ++ show ftype+++-- |Recreate a symlink.+--+-- Throws:+--+--    - `InvalidArgument` if symlink file is wrong type (file)+--    - `InvalidArgument` if symlink file is wrong type (directory)+--    - `PermissionDenied` if output directory cannot be written to+--    - `PermissionDenied` if source directory cannot be opened+--    - `AlreadyExists` if destination file already exists+--    - `SameFile` if source and destination are the same file (`HPathIOException`)+--+-- Note: calls `symlink`+recreateSymlink :: Path Abs  -- ^ the old symlink file+                -> Path Abs  -- ^ destination file+                -> IO ()+recreateSymlink symsource newsym+  = do+    throwSameFile symsource newsym+    sympoint <- readSymbolicLink (fromAbs symsource)+    createSymbolicLink sympoint (fromAbs newsym)+++-- |Copies the given regular file to the given destination.+-- Neither follows symbolic links, nor accepts them.+-- For "copying" symbolic links, use `recreateSymlink` instead.+--+-- Throws:+--+--    - `NoSuchThing` if source file does not exist+--    - `PermissionDenied` if output directory is not writable+--    - `PermissionDenied` if source directory can't be opened+--    - `InvalidArgument` if source file is wrong type (symlink)+--    - `InvalidArgument` if source file is wrong type (directory)+--    - `SameFile` if source and destination are the same file (`HPathIOException`)+--    - `AlreadyExists` if destination already exists+--+-- Note: calls `sendfile`+copyFile :: Path Abs  -- ^ source file+         -> Path Abs  -- ^ destination file+         -> IO ()+copyFile from to = do+  throwSameFile from to+  _copyFile [SPDF.oNofollow]+            [SPDF.oNofollow, SPDF.oExcl]+            from to+++-- |Like `copyFile` except it overwrites the destination if it already+-- exists.+-- This also works if source and destination are the same file.+--+-- Safety/reliability concerns:+--+--    * not atomic+--    * falls back to delete-copy method with explicit checks+--+-- Throws:+--+--    - `NoSuchThing` if source file does not exist+--    - `PermissionDenied` if output directory is not writable+--    - `PermissionDenied` if source directory can't be opened+--    - `InvalidArgument` if source file is wrong type (symlink)+--    - `InvalidArgument` if source file is wrong type (directory)+--    - `SameFile` if source and destination are the same file (`HPathIOException`)+--+-- Note: calls `sendfile`+copyFileOverwrite :: Path Abs  -- ^ source file+                  -> Path Abs  -- ^ destination file+                  -> IO ()+copyFileOverwrite from to = do+  throwSameFile from to+  catchIOError (_copyFile [SPDF.oNofollow]+                          [SPDF.oNofollow, SPDF.oTrunc]+                          from to) $ \e ->+    case ioeGetErrorType e of+      -- if the destination file is not writable, we need to+      -- figure out if we can still copy by deleting it first+      PermissionDenied -> do+        exists   <- doesFileExist to+        writable <- isWritable (dirname to)+        if exists && writable+          then deleteFile to >> copyFile from to+          else ioError e+      _ -> ioError e+++_copyFile :: [SPDF.Flags]+          -> [SPDF.Flags]+          -> Path Abs  -- ^ source file+          -> Path Abs  -- ^ destination file+          -> IO ()+_copyFile sflags dflags from to+  =+    -- TODO: add sendfile support+    withAbsPath to $ \to' -> withAbsPath from $ \from' ->+      void $ fallbackCopy from' to'+  where+    -- low-level copy operation utilizing read(2)/write(2)+    -- in case `sendFileCopy` fails/is unsupported+    fallbackCopy source dest =+      bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)+              SPI.closeFd+              $ \sfd -> do+                fileM <- System.Posix.Files.ByteString.fileMode+                         <$> getFdStatus sfd+                bracketeer (SPDT.openFd dest SPI.WriteOnly+                             dflags $ Just fileM)+                           SPI.closeFd+                           (\fd -> SPI.closeFd fd >> deleteFile to)+                            $ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->+                                        write' sfd dfd buf 0+      where+        bufSize :: CSize+        bufSize = 8192+        write' :: Fd -> Fd -> Ptr Word8 -> Int -> IO Int+        write' sfd dfd buf totalsize = do+            size <- SPB.fdReadBuf sfd buf bufSize+            if size == 0+              then return $ fromIntegral totalsize+              else do rsize <- SPB.fdWriteBuf dfd buf size+                      when (rsize /= size) (throwIO . CopyFailed $ "wrong size!")+                      write' sfd dfd buf (totalsize + fromIntegral size)+++-- |Copies anything. In case of a symlink,+-- it is just recreated, even if it points to a directory.+--+-- Safety/reliability concerns:+--+--    * examines filetypes explicitly+--    * calls `copyDirRecursive` for directories+easyCopy :: Path Abs+         -> Path Abs+         -> IO ()+easyCopy from to = do+  ftype <- getFileType from+  case ftype of+       SymbolicLink -> recreateSymlink from to+       RegularFile  -> copyFile from to+       Directory    -> copyDirRecursive from to+       _            -> ioError $ userError $ "No idea what to do with the" +++                                             "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+++++++    ---------------------+    --[ File Deletion ]--+    ---------------------+++-- |Deletes the given file, does not follow symlinks. Raises `eISDIR`+-- if run on a directory. Does not follow symbolic links.+--+-- Throws:+--+--    - `InappropriateType` for wrong file type (directory)+--    - `NoSuchThing` if the file does not exist+--    - `PermissionDenied` if the directory cannot be read+deleteFile :: Path Abs -> IO ()+deleteFile p = withAbsPath p removeLink+++-- |Deletes the given directory, which must be empty, never symlinks.+--+-- Throws:+--+--    - `InappropriateType` for wrong file type (symlink to directory)+--    - `InappropriateType` for wrong file type (regular file)+--    - `NoSuchThing` if directory does not exist+--    - `UnsatisfiedConstraints` if directory is not empty+--    - `PermissionDenied` if we can't open or write to parent directory+--+-- Notes: calls `rmdir`+deleteDir :: Path Abs -> IO ()+deleteDir p = withAbsPath p removeDirectory+++-- |Deletes the given directory recursively. Does not follow symbolic+-- links. Tries `deleteDir` first before attemtping a recursive+-- deletion.+--+-- Safety/reliability concerns:+--+--    * not atomic+--    * examines filetypes explicitly+--+-- Throws:+--+--    - `InappropriateType` for wrong file type (symlink to directory)+--    - `InappropriateType` for wrong file type (regular file)+--    - `NoSuchThing` if directory does not exist+--    - `PermissionDenied` if we can't open or write to parent directory+deleteDirRecursive :: Path Abs -> IO ()+deleteDirRecursive p =+  catchErrno [eNOTEMPTY, eEXIST]+             (deleteDir p)+    $ do+      files <- getDirsFiles p+      for_ files $ \file -> do+        ftype <- getFileType file+        case ftype of+          SymbolicLink -> deleteFile file+          Directory    -> deleteDirRecursive file+          RegularFile  -> deleteFile file+          _            -> ioError $ userError $ "No idea what to do with the" +++                                                "given filetype: " ++ show ftype+      removeDirectory . toFilePath $ p+++-- |Deletes a file, directory or symlink, whatever it may be.+-- In case of directory, performs recursive deletion. In case of+-- a symlink, the symlink file is deleted.+--+-- Safety/reliability concerns:+--+--    * examines filetypes explicitly+--    * calls `deleteDirRecursive` for directories+easyDelete :: Path Abs -> IO ()+easyDelete p = do+  ftype <- getFileType p+  case ftype of+    SymbolicLink -> deleteFile p+    Directory    -> deleteDirRecursive p+    RegularFile  -> deleteFile p+    _            -> ioError $ userError $ "No idea what to do with the" +++                                          "given filetype: " ++ show ftype+++++    --------------------+    --[ File Opening ]--+    --------------------+++-- |Opens a file appropriately by invoking xdg-open. The file type+-- is not checked. This forks a process.+openFile :: Path Abs+         -> IO ProcessID+openFile p =+  withAbsPath p $ \fp ->+    SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing+++-- |Executes a program with the given arguments. This forks a process.+executeFile :: Path Abs        -- ^ program+            -> [ByteString]    -- ^ arguments+            -> IO ProcessID+executeFile fp args+  = withAbsPath fp $ \fpb ->+      SPP.forkProcess+      $ SPP.executeFile fpb True args Nothing+++++    ---------------------+    --[ File Creation ]--+    ---------------------+++-- |Create an empty regular file at the given directory with the given filename.+--+-- Throws:+--+--    - `PermissionDenied` if output directory cannot be written to+--    - `AlreadyExists` if destination file already exists+createRegularFile :: Path Abs -> IO ()+createRegularFile dest =+  bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just newFilePerms)+                      (SPI.defaultFileFlags { exclusive = True }))+          SPI.closeFd+          (\_ -> return ())+++-- |Create an empty directory at the given directory with the given filename.+--+-- Throws:+--+--    - `PermissionDenied` if output directory cannot be written to+--    - `AlreadyExists` if destination directory already exists+createDir :: Path Abs -> IO ()+createDir dest = createDirectory (fromAbs dest) newDirPerms+++++    ----------------------------+    --[ File Renaming/Moving ]--+    ----------------------------+++-- |Rename a given file with the provided filename. Destination and source+-- must be on the same device, otherwise `eXDEV` will be raised.+--+-- Does not follow symbolic links, but renames the symbolic link file.+--+-- Safety/reliability concerns:+--+--    * has a separate set of exception handling, apart from the syscall+--+-- Throws:+--+--     - `NoSuchThing` if source file does not exist+--     - `PermissionDenied` if output directory cannot be written to+--     - `PermissionDenied` if source directory cannot be opened+--     - `UnsupportedOperation` if source and destination are on different devices+--     - `FileDoesExist` if destination file already exists+--     - `DirDoesExist` if destination directory already exists+--     - `SameFile` if destination and source are the same file (`HPathIOException`)+--+-- Note: calls `rename` (but does not allow to rename over existing files)+renameFile :: Path Abs -> Path Abs -> IO ()+renameFile fromf tof = do+  throwSameFile fromf tof+  throwFileDoesExist tof+  throwDirDoesExist tof+  rename (fromAbs fromf) (fromAbs tof)+++-- |Move a file. This also works across devices by copy-delete fallback.+-- And also works on directories.+--+-- Does not follow symbolic links, but renames the symbolic link file.+--+-- Safety/reliability concerns:+--+--    * copy-delete fallback is inherently non-atomic+--+-- Throws:+--+--     - `NoSuchThing` if source file does not exist+--     - `PermissionDenied` if output directory cannot be written to+--     - `PermissionDenied` if source directory cannot be opened+--     - `FileDoesExist` if destination file already exists+--     - `DirDoesExist` if destination directory already exists+--     - `SameFile` if destination and source are the same file (`HPathIOException`)+--+-- Note: calls `rename` (but does not allow to rename over existing files)+moveFile :: Path Abs  -- ^ file to move+         -> Path Abs  -- ^ destination+         -> IO ()+moveFile from to = do+  throwSameFile from to+  catchErrno [eXDEV] (renameFile from to) $ do+    easyCopy from to+    easyDelete from+++-- |Like `moveFile`, but overwrites the destination if it exists.+--+-- Does not follow symbolic links, but renames the symbolic link file.+--+-- Safety/reliability concerns:+--+--    * copy-delete fallback is inherently non-atomic+--    * checks for file types and destination file existence explicitly+--+-- Throws:+--+--     - `NoSuchThing` if source file does not exist+--     - `PermissionDenied` if output directory cannot be written to+--     - `PermissionDenied` if source directory cannot be opened+--     - `SameFile` if destination and source are the same file (`HPathIOException`)+--+-- Note: calls `rename` (but does not allow to rename over existing files)+moveFileOverwrite :: Path Abs  -- ^ file to move+                  -> Path Abs  -- ^ destination+                  -> IO ()+moveFileOverwrite from to = do+  throwSameFile from to+  ft <- getFileType from+  writable <- isWritable $ dirname to+  case ft of+    RegularFile -> do+      exists <- doesFileExist to+      when (exists && writable) (deleteFile to)+    SymbolicLink -> do+      exists <- doesFileExist to+      when (exists && writable) (deleteFile to)+    Directory -> do+      exists <- doesDirectoryExist to+      when (exists && writable) (deleteDir to)+    _ -> ioError $ userError $ "Don't know how to handle filetype " +++                               show ft+  moveFile from to+++++    -----------------------+    --[ File Permissions]--+    -----------------------+++-- |Default permissions for a new file.+newFilePerms :: FileMode+newFilePerms+  =                  ownerWriteMode+    `unionFileModes` ownerReadMode+    `unionFileModes` groupWriteMode+    `unionFileModes` groupReadMode+    `unionFileModes` otherWriteMode+    `unionFileModes` otherReadMode+++-- |Default permissions for a new directory.+newDirPerms :: FileMode+newDirPerms+  =                  ownerModes+    `unionFileModes` groupExecuteMode+    `unionFileModes` groupReadMode+    `unionFileModes` otherExecuteMode+    `unionFileModes` otherReadMode++++    -------------------------+    --[ Directory reading ]--+    -------------------------+++-- |Gets all filenames of the given directory. This excludes "." and "..".+-- This version does not follow symbolic links.+--+-- Throws:+--+--     - `NoSuchThing` if directory does not exist+--     - `InappropriateType` if file type is wrong (file)+--     - `InappropriateType` if file type is wrong (symlink to file)+--     - `InappropriateType` if file type is wrong (symlink to dir)+--     - `PermissionDenied` if directory cannot be opened+getDirsFiles :: Path Abs        -- ^ dir to read+             -> IO [Path Abs]+getDirsFiles p =+  withAbsPath p $ \fp ->+    bracketOnError (SPDT.openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing)+            SPI.closeFd+            $ \fd ->+              return+                . catMaybes+                .   fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))+                =<< getDirectoryContents' fd+  where+    parseMaybe :: ByteString -> Maybe (Path Fn)+    parseMaybe = parseFn+++++    ---------------------------+    --[ FileType operations ]--+    ---------------------------+++-- |Get the file type of the file located at the given path. Does+-- not follow symbolic links.+--+-- Throws:+--+--    - `NoSuchThing` if the file does not exist+--    - `PermissionDenied` if any part of the path is not accessible+getFileType :: Path Abs -> IO FileType+getFileType p = do+  fs <- PF.getSymbolicLinkStatus (fromAbs p)+  decide fs+  where+    decide fs+      | PF.isDirectory fs       = return Directory+      | PF.isRegularFile fs     = return RegularFile+      | PF.isSymbolicLink fs    = return SymbolicLink+      | PF.isBlockDevice fs     = return BlockDevice+      | PF.isCharacterDevice fs = return CharacterDevice+      | PF.isNamedPipe fs       = return NamedPipe+      | PF.isSocket fs          = return Socket+      | otherwise               = ioError $ userError "No filetype?!"++++    --------------+    --[ Others ]--+    --------------++++-- |Applies `realpath` on the given absolute path.+--+-- Throws:+--+--    - `NoSuchThing` if the file at the given path does not exist+--    - `NoSuchThing` if the symlink is broken+canonicalizePath :: Path Abs -> IO (Path Abs)+canonicalizePath (MkPath l) = do+  nl <- SPDT.realpath l+  return $ MkPath nl
+ src/HPath/IO/Errors.hs view
@@ -0,0 +1,330 @@+-- |+-- Module      :  HPath.IO.Errors+-- Copyright   :  © 2016 Julian Ospald+-- License     :  GPL-2+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- Provides error handling.++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HPath.IO.Errors where+++import Control.Applicative+  (+    (<$>)+  )+import Control.Exception+import Control.Monad+  (+    forM+  , when+  )+import Data.ByteString+  (+    ByteString+  )+import Data.Data+  (+    Data(..)+  )+import Data.Typeable+import Foreign.C.Error+  (+    getErrno+  , Errno+  )+import GHC.IO.Exception+  (+    IOErrorType+  )+import HPath+import HPath.IO.Utils+import System.IO.Error+  (+    catchIOError+  , ioeGetErrorType+  )++import qualified System.Posix.Directory.ByteString as PFD+import System.Posix.Files.ByteString+  (+    fileAccess+  , getFileStatus+  )+import qualified System.Posix.Files.ByteString as PF+++data HPathIOException = FileDoesNotExist ByteString+                      | DirDoesNotExist ByteString+                      | PathNotAbsolute ByteString+                      | FileNotExecutable ByteString+                      | SameFile ByteString ByteString+                      | NotAFile ByteString+                      | NotADir ByteString+                      | DestinationInSource ByteString ByteString+                      | FileDoesExist ByteString+                      | DirDoesExist ByteString+                      | IsSymlink ByteString+                      | InvalidOperation String+                      | InvalidFileName+                      | Can'tOpenDirectory ByteString+                      | CopyFailed String+                      | MoveFailed String+  deriving (Typeable, Eq, Data)+++instance Show HPathIOException where+  show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp+  show (DirDoesNotExist fp) = "Directory does not exist: "+                              ++ fpToString fp+  show (PathNotAbsolute fp) = "Path not absolute: " ++ fpToString fp+  show (FileNotExecutable fp) = "File not executable: "+                                ++ fpToString fp+  show (SameFile fp1 fp2) = fpToString fp1+                            ++ " and " ++ fpToString fp2+                            ++ " are the same file!"+  show (NotAFile fp) = "Not a file: " ++ fpToString fp+  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++++isDestinationInSource :: HPathIOException -> Bool+isDestinationInSource (DestinationInSource _ _) = True+isDestinationInSource _                         = False+++isSameFile :: HPathIOException -> Bool+isSameFile (SameFile _ _) = True+isSameFile _              = False+++isFileDoesExist :: HPathIOException -> Bool+isFileDoesExist (FileDoesExist _) = True+isFileDoesExist _                 = False+++isDirDoesExist :: HPathIOException -> Bool+isDirDoesExist (DirDoesExist _) = True+isDirDoesExist _                = False++++    ----------------------------+    --[ Path based functions ]--+    ----------------------------+++throwFileDoesExist :: Path Abs -> IO ()+throwFileDoesExist fp =+  whenM (doesFileExist fp) (throwIO . FileDoesExist+                                    . fromAbs $ fp)+++throwDirDoesExist :: Path Abs -> IO ()+throwDirDoesExist fp =+  whenM (doesDirectoryExist fp) (throwIO . DirDoesExist+                                         . fromAbs $ fp)+++throwFileDoesNotExist :: Path Abs -> IO ()+throwFileDoesNotExist 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.+throwSameFile :: Path Abs+              -> Path Abs+              -> IO ()+throwSameFile fp1 fp2 =+  whenM (sameFile fp1 fp2)+        (throwIO $ SameFile (fromAbs fp1) (fromAbs fp2))+++-- |Check if the files are the same by examining device and file id.+-- This follows symbolic links.+sameFile :: Path Abs -> Path Abs -> IO Bool+sameFile fp1 fp2 =+  withAbsPath fp1 $ \fp1' -> withAbsPath fp2 $ \fp2' ->+    handleIOError (\_ -> return False) $ do+      fs1 <- getFileStatus fp1'+      fs2 <- getFileStatus fp2'++      if ((PF.deviceID fs1, PF.fileID fs1) ==+          (PF.deviceID fs2, PF.fileID fs2))+        then return True+        else return False+++-- |Checks whether the destination directory is contained+-- within the source directory by comparing the device+file ID of the+-- source directory with all device+file IDs of the parent directories+-- of the destination.+throwDestinationInSource :: Path Abs -- ^ source dir+                         -> Path Abs -- ^ full destination, `dirname dest`+                                     --   must exist+                         -> IO ()+throwDestinationInSource source dest = do+  dest'   <- (\x -> maybe x (\y -> x </> y) $ basename dest)+             {- <$> (canonicalizePath $ P.dirname dest) -}+             <$> (return $ dirname dest)+  dids <- forM (getAllParents dest') $ \p -> do+          fs <- PF.getSymbolicLinkStatus (fromAbs p)+          return (PF.deviceID fs, PF.fileID fs)+  sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))+              $ PF.getFileStatus (fromAbs source)+  when (elem sid dids)+       (throwIO $ DestinationInSource (fromAbs dest)+                                      (fromAbs source))+++-- |Checks if the given file exists and is not a directory.+-- Does not follow symlinks.+doesFileExist :: Path Abs -> IO Bool+doesFileExist fp =+  handleIOError (\_ -> return False) $ do+    fs  <- PF.getSymbolicLinkStatus (fromAbs fp)+    return $ not . PF.isDirectory $ fs+++-- |Checks if the given file exists and is a directory.+-- Does not follow symlinks.+doesDirectoryExist :: Path Abs -> IO Bool+doesDirectoryExist fp =+  handleIOError (\_ -> return False) $ do+    fs  <- PF.getSymbolicLinkStatus (fromAbs fp)+    return $ PF.isDirectory fs+++-- |Checks whether a file or folder is writable.+isWritable :: Path Abs -> IO Bool+isWritable fp =+  handleIOError (\_ -> return False) $+    fileAccess (fromAbs fp) False True False+++-- |Checks whether the directory at the given path exists and can be+-- opened. This invokes `openDirStream` which follows symlinks.+canOpenDirectory :: Path Abs -> IO Bool+canOpenDirectory fp =+  handleIOError (\_ -> return False) $ do+    bracket (PFD.openDirStream . fromAbs $ fp)+            PFD.closeDirStream+            (\_ -> return ())+    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)++++    --------------------------------+    --[ Error handling functions ]--+    --------------------------------+++-- |Carries out an action, then checks if there is an IOException and+-- a specific errno. If so, then it carries out another action, otherwise+-- it rethrows the error.+catchErrno :: [Errno] -- ^ errno to catch+           -> IO a    -- ^ action to try, which can raise an IOException+           -> IO a    -- ^ action to carry out in case of an IOException and+                      --   if errno matches+           -> IO a+catchErrno en a1 a2 =+  catchIOError a1 $ \e -> do+    errno <- getErrno+    if errno `elem` en+      then a2+      else ioError e+++-- |Execute the given action and retrow IO exceptions as a new Exception+-- that have the given errno. If errno does not match the exception is rethrown+-- as is.+rethrowErrnoAs :: Exception e+               => [Errno]       -- ^ errno to catch+               -> e             -- ^ rethrow as if errno matches+               -> IO a          -- ^ action to try+               -> IO a+rethrowErrnoAs en fmex action = catchErrno en action (throwIO fmex)++++-- |Like `catchIOError`, with arguments swapped.+handleIOError :: (IOError -> IO a) -> IO a -> IO a+handleIOError = flip catchIOError+++-- |Like `bracket`, but allows to have different clean-up+-- actions depending on whether the in-between computation+-- has raised an exception or not. +bracketeer :: IO a        -- ^ computation to run first+           -> (a -> IO b) -- ^ computation to run last, when+                          --   no exception was raised+           -> (a -> IO b) -- ^ computation to run last,+                          --   when an exception was raised+           -> (a -> IO c) -- ^ computation to run in-between+           -> IO c+bracketeer before after afterEx thing =+  mask $ \restore -> do+    a <- before+    r <- restore (thing a) `onException` afterEx a+    _ <- after a+    return r+++reactOnError :: IO a+             -> [(IOErrorType, IO a)]   -- ^ reaction on IO errors+             -> [(HPathIOException, IO a)] -- ^ reaction on FmIOException+             -> IO a+reactOnError a ios fmios =+  a `catches` [iohandler, fmiohandler]+  where+    iohandler = Handler $+      \(ex :: IOException) ->+         foldr (\(t, a') y -> if ioeGetErrorType ex == t+                                then a'+                                else y)+               (throwIO ex)+               ios+    fmiohandler = Handler $+      \(ex :: HPathIOException) ->+         foldr (\(t, a') y -> if toConstr ex == toConstr t+                                then a'+                                else y)+               (throwIO ex)+               fmios
+ src/HPath/IO/Utils.hs view
@@ -0,0 +1,32 @@+-- |+-- 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)
+ src/HPath/Internal.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | Internal types and functions.++module HPath.Internal+  (Path(..)+  ,RelC)+  where++import Control.DeepSeq (NFData (..))+import Data.ByteString (ByteString)+import Data.Data++-- | Path of some base and type.+--+-- Internally is a string. The string can be of two formats only:+--+-- 1. without trailing path separator: @file.txt@, @foo\/bar.txt@, @\/foo\/bar.txt@+-- 2. with trailing path separator: @foo\/@, @\/foo\/bar\/@+--+-- There are no duplicate+-- path separators @\/\/@, no @..@, no @.\/@, no @~\/@, etc.+data Path b = MkPath ByteString+  deriving (Typeable)++-- | String equality.+--+-- The following property holds:+--+-- @show x == show y ≡ x == y@+instance Eq (Path b) where+  (==) (MkPath x) (MkPath y) = x == y++-- | String ordering.+--+-- The following property holds:+--+-- @show x \`compare\` show y ≡ x \`compare\` y@+instance Ord (Path b) where+  compare (MkPath x) (MkPath y) = compare x y++-- | Same as 'Path.toFilePath'.+--+-- The following property holds:+--+-- @x == y ≡ show x == show y@+instance Show (Path b) where+  show (MkPath x) = show x++instance NFData (Path b) where+  rnf (MkPath x) = rnf x+++class RelC m+
+ src/System/Posix/Directory/Foreign.hsc view
@@ -0,0 +1,55 @@+module System.Posix.Directory.Foreign where++import Data.Bits+import Data.List (foldl')+import Foreign.C.Types++#include <limits.h>+#include <stdlib.h>+#include <dirent.h>+#include <sys/types.h>+#include <sys/stat.h>+#include <fcntl.h>++newtype DirType = DirType Int deriving (Eq, Show)+data Flags = Flags Int | UnsupportedFlag String deriving (Eq, Show)++unFlags :: Flags -> Int+unFlags (Flags i) = i+unFlags (UnsupportedFlag name) = error (name ++ " is not supported on this platform")++-- |Returns @True@ if posix-paths was compiled with support for the provided+-- flag. (As of this writing, the only flag for which this check may be+-- necessary is 'oCloexec'; all other flags will always yield @True@.)+isSupported :: Flags -> Bool+isSupported (Flags _) = True+isSupported _ = False++-- |@O_CLOEXEC@ is not supported on every POSIX platform. Use+-- @'isSupported' oCloexec@ to determine if support for @O_CLOEXEC@ was+-- compiled into your version of posix-paths. (If not, using @oCloexec@ will+-- throw an exception.)+oCloexec :: Flags+#ifdef O_CLOEXEC+oCloexec = Flags #{const O_CLOEXEC}+#else+{-# WARNING oCloexec+    "This version of posix-paths was compiled without @O_CLOEXEC@ support." #-}+oCloexec = UnsupportedFlag "O_CLOEXEC"+#endif++++-- If these enum declarations occur earlier in the file, haddock+-- gets royally confused about the above doc comments.+-- Probably http://trac.haskell.org/haddock/ticket/138++#{enum DirType, DirType, DT_BLK, DT_CHR, DT_DIR, DT_FIFO, DT_LNK, DT_REG, DT_SOCK, DT_UNKNOWN}++#{enum Flags, Flags, O_APPEND, O_ASYNC, O_CREAT, O_DIRECTORY, O_EXCL, O_NOCTTY, O_NOFOLLOW, O_NONBLOCK, O_RDONLY, O_WRONLY, O_RDWR, O_SYNC, O_TRUNC}++pathMax :: Int+pathMax = #{const PATH_MAX}++unionFlags :: [Flags] -> CInt+unionFlags = fromIntegral . foldl' ((. unFlags) . (.|.)) 0
+ src/System/Posix/Directory/Traversals.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wall #-}+module System.Posix.Directory.Traversals (++  getDirectoryContents+, getDirectoryContents'++, allDirectoryContents+, allDirectoryContents'+, traverseDirectory++-- lower-level stuff+, readDirEnt+, packDirStream+, unpackDirStream+, openFd++, realpath+) where++import Control.Applicative+import Control.Monad+import System.Posix.FilePath ((</>))+import System.Posix.Directory.Foreign++import qualified System.Posix as Posix+import System.IO.Error+import Control.Exception+import qualified Data.ByteString.Char8 as BS+import System.Posix.ByteString.FilePath+import System.Posix.Directory.ByteString as PosixBS+import System.Posix.Files.ByteString++import System.IO.Unsafe+import Unsafe.Coerce (unsafeCoerce)+import Foreign.C.Error+import Foreign.C.String+import Foreign.C.Types+import Foreign.Marshal.Alloc (alloca,allocaBytes)+import Foreign.Ptr+import Foreign.Storable+++++----------------------------------------------------------++-- | Get all files from a directory and its subdirectories.+--+-- Upon entering a directory, 'allDirectoryContents' will get all entries+-- strictly.  However the returned list is lazy in that directories will only+-- be accessed on demand.+allDirectoryContents :: RawFilePath -> IO [RawFilePath]+allDirectoryContents topdir = do+    namesAndTypes <- getDirectoryContents topdir+    let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes+    paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do+        let path = topdir </> name+        case () of+            () | typ == dtDir -> allDirectoryContents path+               | typ == dtUnknown -> do+                    isDir <- isDirectory <$> getFileStatus path+                    if isDir+                        then allDirectoryContents path+                        else return [path]+               | otherwise -> return [path]+    return (topdir : concat paths)++-- | Get all files from a directory and its subdirectories strictly.+allDirectoryContents' :: RawFilePath -> IO [RawFilePath]+allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) []+-- this uses traverseDirectory because it's more efficient than forcing the+-- lazy version.++-- | Recursively apply the 'action' to the parent directory and all+-- files/subdirectories.+--+-- This function allows for memory-efficient traversals.+traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s+traverseDirectory act s0 topdir = toploop+  where+    toploop = do+        isDir <- isDirectory <$> getFileStatus topdir+        s' <- act s0 topdir+        if isDir then actOnDirContents topdir s' loop+                 else return s'+    loop typ path acc = do+        isDir <- case () of+            () | typ == dtDir     -> return True+               | typ == dtUnknown -> isDirectory <$> getFileStatus path+               | otherwise        -> return False+        if isDir+          then act acc path >>= \acc' -> actOnDirContents path acc' loop+          else act acc path++actOnDirContents :: RawFilePath+                 -> b+                 -> (DirType -> RawFilePath -> b -> IO b)+                 -> IO b+actOnDirContents pathRelToTop b f =+  modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .+                 (`ioeSetLocation` "findBSTypRel")) $ do+    bracket+      (openDirStream pathRelToTop)+      (Posix.closeDirStream)+      (\dirp -> loop dirp b)+ where+  loop dirp b' = do+    (typ,e) <- readDirEnt dirp+    if (e == "")+      then return b'+      else do+          if (e == "." || e == "..")+              then loop dirp b'+              else f typ (pathRelToTop </> e) b' >>= loop dirp+++----------------------------------------------------------+-- dodgy stuff++type CDir = ()+type CDirent = ()++-- Posix doesn't export DirStream, so to re-use that type we need to use+-- unsafeCoerce.  It's just a newtype, so this is a legitimate usage.+-- ugly trick.+unpackDirStream :: DirStream -> Ptr CDir+unpackDirStream = unsafeCoerce++packDirStream :: Ptr CDir -> DirStream+packDirStream = unsafeCoerce++-- the __hscore_* functions are defined in the unix package.  We can import them and let+-- the linker figure it out.+foreign import ccall unsafe "__hscore_readdir"+  c_readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt++foreign import ccall unsafe "__hscore_free_dirent"+  c_freeDirEnt  :: Ptr CDirent -> IO ()++foreign import ccall unsafe "__hscore_d_name"+  c_name :: Ptr CDirent -> IO CString++foreign import ccall unsafe "__posixdir_d_type"+  c_type :: Ptr CDirent -> IO DirType++foreign import ccall "realpath"+  c_realpath :: CString -> CString -> IO CString++foreign import ccall unsafe "fdopendir"+  c_fdopendir :: Posix.Fd -> IO (Ptr ())++foreign import ccall unsafe "open"+   c_open :: CString -> CInt -> Posix.CMode -> IO CInt++----------------------------------------------------------+-- less dodgy but still lower-level+++readDirEnt :: DirStream -> IO (DirType, RawFilePath)+readDirEnt (unpackDirStream -> dirp) =+  alloca $ \ptr_dEnt  -> loop ptr_dEnt+ where+  loop ptr_dEnt = do+    resetErrno+    r <- c_readdir dirp ptr_dEnt+    if (r == 0)+       then do+         dEnt <- peek ptr_dEnt+         if (dEnt == nullPtr)+            then return (dtUnknown,BS.empty)+            else do+                 dName <- c_name dEnt >>= peekFilePath+                 dType <- c_type dEnt+                 c_freeDirEnt dEnt+                 return (dType, dName)+       else do+         errno <- getErrno+         if (errno == eINTR)+            then loop ptr_dEnt+            else do+                 let (Errno eo) = errno+                 if (eo == 0)+                    then return (dtUnknown,BS.empty)+                    else throwErrno "readDirEnt"+++getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]+getDirectoryContents path =+  modifyIOError ((`ioeSetFileName` (BS.unpack path)) .+                 (`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $ do+    bracket+      (PosixBS.openDirStream path)+      PosixBS.closeDirStream+      loop+ where+  loop dirp = do+     t@(_typ,e) <- readDirEnt dirp+     if BS.null e then return [] else do+       es <- loop dirp+       return (t:es)+++fdOpendir :: Posix.Fd -> IO DirStream+fdOpendir fd =+    packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)+++getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)]+getDirectoryContents' fd =+    bracket+      (fdOpendir fd)+      PosixBS.closeDirStream+      loop+ where+  loop dirp = do+     t@(_typ,e) <- readDirEnt dirp+     if BS.null e then return [] else do+       es <- loop dirp+       return (t:es)+++open_  :: CString+       -> Posix.OpenMode+       -> [Flags]+       -> Maybe Posix.FileMode+       -> IO Posix.Fd+open_ str how optional_flags maybe_mode = do+    fd <- c_open str all_flags mode_w+    return (Posix.Fd fd)+  where+    all_flags  = unionFlags $ optional_flags ++ [open_mode] ++ creat+++    (creat, mode_w) = case maybe_mode of+                        Nothing -> ([],0)+                        Just x  -> ([oCreat], x)++    open_mode = case how of+                   Posix.ReadOnly  -> oRdonly+                   Posix.WriteOnly -> oWronly+                   Posix.ReadWrite -> oRdwr+++-- |Open and optionally create this file.  See 'System.Posix.Files'+-- for information on how to use the 'FileMode' type.+openFd :: RawFilePath+       -> Posix.OpenMode+       -> [Flags]+       -> Maybe Posix.FileMode+       -> IO Posix.Fd+openFd name how optional_flags maybe_mode =+   withFilePath name $ \str ->+     throwErrnoPathIfMinus1Retry "openFd" name $+       open_ str how optional_flags maybe_mode+++-- | return the canonicalized absolute pathname+--+-- like canonicalizePath, but uses realpath(3)+realpath :: RawFilePath -> IO RawFilePath+realpath inp = do+    allocaBytes pathMax $ \tmp -> do+        void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp+        BS.packCString tmp
+ src/System/Posix/FilePath.hs view
@@ -0,0 +1,649 @@+-- |+-- Module      :  System.Posix.FilePath+-- Copyright   :  © 2016 Julian Ospald+-- License     :  BSD3+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- The equivalent of "System.FilePath" on raw (byte string) file paths.+--+-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!++{-# LANGUAGE TupleSections #-}++{-# OPTIONS_GHC -Wall #-}+++module System.Posix.FilePath (++  -- * Separators+  pathSeparator+, isPathSeparator+, searchPathSeparator+, isSearchPathSeparator+, extSeparator+, isExtSeparator++  -- * File extensions+, splitExtension+, takeExtension+, replaceExtension+, dropExtension+, addExtension+, hasExtension+, (<.>)+, splitExtensions+, dropExtensions+, takeExtensions++  -- * Filenames/Directory names+, splitFileName+, takeFileName+, replaceFileName+, dropFileName+, takeBaseName+, replaceBaseName+, takeDirectory+, replaceDirectory++  -- * Path combinators and splitters+, combine+, (</>)+, splitPath+, joinPath+, splitDirectories++  -- * Path conversions+, normalise++  -- * Trailing path separator+, hasTrailingPathSeparator+, addTrailingPathSeparator+, dropTrailingPathSeparator++  -- * Queries+, isRelative+, isAbsolute+, isValid+, isFileName+, hasParentDir+, equalFilePath+, hiddenFile++  -- * Type conversion+, fpToString+, userStringToFP++, module System.Posix.ByteString.FilePath+) where++import           Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (fromString, toString)+import           System.Posix.ByteString.FilePath++import           Data.Maybe (isJust)+import           Data.Word8++import           Control.Arrow (second)++-- $setup+-- >>> import Data.Char+-- >>> import Test.QuickCheck+-- >>> import Control.Applicative+-- >>> import qualified Data.ByteString as BS+-- >>> import Data.ByteString (ByteString)+-- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary+-- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack+--+-- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral+++-- | Path separator character+pathSeparator :: Word8+pathSeparator = _slash++-- | Check if a character is the path separator+--+-- prop> \n ->  (_chr n == '/') == isPathSeparator n+isPathSeparator :: Word8 -> Bool+isPathSeparator = (== pathSeparator)++-- | Search path separator+searchPathSeparator :: Word8+searchPathSeparator = _colon++-- | Check if a character is the search path separator+--+-- prop> \n -> (_chr n == ':') == isSearchPathSeparator n+isSearchPathSeparator :: Word8 -> Bool+isSearchPathSeparator = (== searchPathSeparator)++-- | File extension separator+extSeparator :: Word8+extSeparator = _period++-- | Check if a character is the file extension separator+--+-- prop> \n -> (_chr n == '.') == isExtSeparator n+isExtSeparator :: Word8 -> Bool+isExtSeparator = (== extSeparator)++------------------------+-- extension stuff++-- | Split a 'RawFilePath' into a path+filename and extension+--+-- >>> splitExtension "file.exe"+-- ("file",".exe")+-- >>> splitExtension "file"+-- ("file","")+-- >>> splitExtension "/path/file.tar.gz"+-- ("/path/file.tar",".gz")+--+-- prop> \path -> uncurry (BS.append) (splitExtension path) == path+splitExtension :: RawFilePath -> (RawFilePath, ByteString)+splitExtension x = if BS.null basename+    then (x,BS.empty)+    else (BS.append path (BS.init basename),BS.cons extSeparator fileExt)+  where+    (path,file) = splitFileNameRaw x+    (basename,fileExt) = BS.breakEnd isExtSeparator file++-- | Get the final extension from a 'RawFilePath'+--+-- >>> takeExtension "file.exe"+-- ".exe"+-- >>> takeExtension "file"+-- ""+-- >>> takeExtension "/path/file.tar.gz"+-- ".gz"+takeExtension :: RawFilePath -> ByteString+takeExtension = snd . splitExtension++-- | Change a file's extension+--+-- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path+replaceExtension :: RawFilePath -> ByteString -> RawFilePath+replaceExtension path ext = dropExtension path <.> ext++-- | Drop the final extension from a 'RawFilePath'+--+-- >>> dropExtension "file.exe"+-- "file"+-- >>> dropExtension "file"+-- "file"+-- >>> dropExtension "/path/file.tar.gz"+-- "/path/file.tar"+dropExtension :: RawFilePath -> RawFilePath+dropExtension = fst . splitExtension++-- | Add an extension to a 'RawFilePath'+--+-- >>> addExtension "file" ".exe"+-- "file.exe"+-- >>> addExtension "file.tar" ".gz"+-- "file.tar.gz"+-- >>> addExtension "/path/" ".ext"+-- "/path/.ext"+addExtension :: RawFilePath -> ByteString -> RawFilePath+addExtension file ext+    | BS.null ext = file+    | isExtSeparator (BS.head ext) = BS.append file ext+    | otherwise = BS.intercalate (BS.singleton extSeparator) [file, ext]+++-- | Operator version of 'addExtension'+(<.>) :: RawFilePath -> ByteString -> RawFilePath+(<.>) = addExtension++-- | Check if a 'RawFilePath' has an extension+--+-- >>> hasExtension "file"+-- False+-- >>> hasExtension "file.tar"+-- True+-- >>> hasExtension "/path.part1/"+-- False+hasExtension :: RawFilePath -> Bool+hasExtension = isJust . BS.elemIndex extSeparator . takeFileName++-- | Split a 'RawFilePath' on the first extension+--+-- >>> splitExtensions "/path/file.tar.gz"+-- ("/path/file",".tar.gz")+--+-- prop> \path -> uncurry addExtension (splitExtensions path) == path+splitExtensions :: RawFilePath -> (RawFilePath, ByteString)+splitExtensions x = if BS.null basename+    then (path,fileExt)+    else (BS.append path basename,fileExt)+  where+    (path,file) = splitFileNameRaw x+    (basename,fileExt) = BS.break isExtSeparator file++-- | Remove all extensions from a 'RawFilePath'+--+-- >>> dropExtensions "/path/file.tar.gz"+-- "/path/file"+dropExtensions :: RawFilePath -> RawFilePath+dropExtensions = fst . splitExtensions++-- | Take all extensions from a 'RawFilePath'+--+-- >>> takeExtensions "/path/file.tar.gz"+-- ".tar.gz"+takeExtensions :: RawFilePath -> ByteString+takeExtensions = snd . splitExtensions++------------------------+-- more stuff++-- | Split a 'RawFilePath' into (path,file).  'combine' is the inverse+--+-- >>> splitFileName "path/file.txt"+-- ("path/","file.txt")+-- >>> splitFileName "path/"+-- ("path/","")+-- >>> splitFileName "file.txt"+-- ("./","file.txt")+--+-- prop> \path -> uncurry combine (splitFileName path) == path || fst (splitFileName path) == "./"+splitFileName :: RawFilePath -> (RawFilePath, RawFilePath)+splitFileName x = if BS.null path+    then (dotSlash, file)+    else (path,file)+  where+    (path,file) = splitFileNameRaw x+    dotSlash = _period `BS.cons` (BS.singleton pathSeparator)+++-- | Get the file name+--+-- >>> takeFileName "path/file.txt"+-- "file.txt"+-- >>> takeFileName "path/"+-- ""+takeFileName :: RawFilePath -> RawFilePath+takeFileName = snd . splitFileName++-- | Change the file name+--+-- prop> \path -> replaceFileName path (takeFileName path) == path+replaceFileName :: RawFilePath -> ByteString -> RawFilePath+replaceFileName x y = fst (splitFileNameRaw x) </> y++-- | Drop the file name+--+-- >>> dropFileName "path/file.txt"+-- "path/"+-- >>> dropFileName "file.txt"+-- "./"+dropFileName :: RawFilePath -> RawFilePath+dropFileName = fst . splitFileName++-- | Get the file name, without a trailing extension+--+-- >>> takeBaseName "path/file.tar.gz"+-- "file.tar"+-- >>> takeBaseName ""+-- ""+takeBaseName :: RawFilePath -> ByteString+takeBaseName = dropExtension . takeFileName++-- | Change the base name+--+-- >>> replaceBaseName "path/file.tar.gz" "bob"+-- "path/bob.gz"+--+-- prop> \path -> replaceBaseName path (takeBaseName path) == path+replaceBaseName :: RawFilePath -> ByteString -> RawFilePath+replaceBaseName path name = combineRaw dir (name <.> ext)+  where+    (dir,file) = splitFileNameRaw path+    ext = takeExtension file++-- | Get the directory, moving up one level if it's already a directory+--+-- >>> takeDirectory "path/file.txt"+-- "path"+-- >>> takeDirectory "file"+-- "."+-- >>> takeDirectory "/path/to/"+-- "/path/to"+-- >>> takeDirectory "/path/to"+-- "/path"+takeDirectory :: RawFilePath -> RawFilePath+takeDirectory x = case () of+    () | x == BS.singleton pathSeparator -> x+       | BS.null res && not (BS.null file) -> file+       | otherwise -> res+  where+    res = fst $ BS.spanEnd isPathSeparator file+    file = dropFileName x++-- | Change the directory component of a 'RawFilePath'+--+-- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "."+replaceDirectory :: RawFilePath -> ByteString -> RawFilePath+replaceDirectory file dir = combineRaw dir (takeFileName file)++-- | Join two paths together+--+-- >>> combine "/" "file"+-- "/file"+-- >>> combine "/path/to" "file"+-- "/path/to/file"+-- >>> combine "file" "/absolute/path"+-- "/absolute/path"+combine :: RawFilePath -> RawFilePath -> RawFilePath+combine a b | not (BS.null b) && isPathSeparator (BS.head b) = b+            | otherwise = combineRaw a b++-- | Operator version of combine+(</>) :: RawFilePath -> RawFilePath -> RawFilePath+(</>) = combine++-- | Split a path into a list of components:+--+-- >>> splitPath "/path/to/file.txt"+-- ["/","path/","to/","file.txt"]+--+-- prop> \path -> BS.concat (splitPath path) == path+splitPath :: RawFilePath -> [RawFilePath]+splitPath = splitter+  where+    splitter x+      | BS.null x = []+      | otherwise = case BS.elemIndex pathSeparator x of+            Nothing -> [x]+            Just ix -> case BS.findIndex (not . isPathSeparator) $ BS.drop (ix+1) x of+                          Nothing -> [x]+                          Just runlen -> uncurry (:) . second splitter $ BS.splitAt (ix+1+runlen) x++-- | Like 'splitPath', but without trailing slashes+--+-- >>> splitDirectories "/path/to/file.txt"+-- ["/","path","to","file.txt"]+-- >>> splitDirectories ""+-- []+splitDirectories :: RawFilePath -> [RawFilePath]+splitDirectories x+    | BS.null x = []+    | isPathSeparator (BS.head x) = let (root,rest) = BS.splitAt 1 x+                                    in root : splitter rest+    | otherwise = splitter x+  where+    splitter = filter (not . BS.null) . BS.split pathSeparator++-- | 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+++-- |Normalise a file.+--+-- >>> normalise "/file/\\test////"+-- "/file/\\test/"+-- >>> normalise "/file/./test"+-- "/file/test"+-- >>> normalise "/test/file/../bob/fred/"+-- "/test/file/../bob/fred/"+-- >>> normalise "../bob/fred/"+-- "../bob/fred/"+-- >>> normalise "./bob/fred/"+-- "bob/fred/"+-- >>> normalise "./bob////.fred/./...///./..///#."+-- "bob/.fred/.../../#."+-- >>> normalise "."+-- "."+-- >>> normalise "./"+-- "./"+-- >>> normalise "./."+-- "./"+-- >>> normalise "/./"+-- "/"+-- >>> normalise "/"+-- "/"+-- >>> normalise "bob/fred/."+-- "bob/fred/"+-- >>> normalise "//home"+-- "/home"+normalise :: RawFilePath -> RawFilePath+normalise filepath =+  result `BS.append`+  (if addPathSeparator+       then BS.singleton pathSeparator+       else BS.empty)+  where+    result = let n = f filepath+             in if BS.null n+                then BS.singleton _period+                else n+    addPathSeparator = isDirPath filepath &&+      not (hasTrailingPathSeparator result)+    isDirPath xs = hasTrailingPathSeparator xs+        || not (BS.null xs) && BS.last xs == _period+           && hasTrailingPathSeparator (BS.init xs)+    f = joinPath . dropDots . propSep . splitDirectories+    propSep :: [ByteString] -> [ByteString]+    propSep (x:xs)+      | BS.all (== pathSeparator) x = BS.singleton pathSeparator : xs+      | otherwise                   = x : xs+    propSep [] = []+    dropDots :: [ByteString] -> [ByteString]+    dropDots = filter (BS.singleton _period /=)+++------------------------+-- trailing path separators++-- | Check if the last character of a 'RawFilePath' is '/'.+--+-- >>> hasTrailingPathSeparator "/path/"+-- True+-- >>> hasTrailingPathSeparator "/"+-- True+-- >>> hasTrailingPathSeparator "/path"+-- False+hasTrailingPathSeparator :: RawFilePath -> Bool+hasTrailingPathSeparator x+  | BS.null x = False+  | otherwise = isPathSeparator $ BS.last x++-- | Add a trailing path separator.+--+-- >>> addTrailingPathSeparator "/path"+-- "/path/"+-- >>> addTrailingPathSeparator "/path/"+-- "/path/"+-- >>> addTrailingPathSeparator "/"+-- "/"+addTrailingPathSeparator :: RawFilePath -> RawFilePath+addTrailingPathSeparator x = if hasTrailingPathSeparator x+    then x+    else x `BS.snoc` pathSeparator++-- | Remove a trailing path separator+--+-- >>> dropTrailingPathSeparator "/path/"+-- "/path"+-- >>> dropTrailingPathSeparator "/path////"+-- "/path"+-- >>> dropTrailingPathSeparator "/"+-- "/"+-- >>> dropTrailingPathSeparator "//"+-- "/"+dropTrailingPathSeparator :: RawFilePath -> RawFilePath+dropTrailingPathSeparator x+  | x == BS.singleton pathSeparator = x+  | otherwise = if hasTrailingPathSeparator x+                  then dropTrailingPathSeparator $ BS.init x+                  else x++------------------------+-- 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+    pathDoubleDot = BS.pack [_period, _period]++-- |Equality of two filepaths. The filepaths are normalised+-- and trailing path separators are dropped.+--+-- >>> equalFilePath "foo" "foo"+-- True+-- >>> equalFilePath "foo" "foo/"+-- True+-- >>> equalFilePath "foo" "./foo"+-- True+-- >>> equalFilePath "foo" "/foo"+-- False+-- >>> equalFilePath "foo" "FOO"+-- False+-- >>> equalFilePath "foo" "../foo"+-- False+--+-- prop> \p -> equalFilePath p p+equalFilePath :: RawFilePath -> RawFilePath -> Bool+equalFilePath p1 p2 = f p1 == f p2+  where+    f x = dropTrailingPathSeparator $ normalise x+++-- | Whether the file is a hidden file.+--+-- >>> hiddenFile ".foo"+-- True+-- >>> hiddenFile "..foo.bar"+-- True+-- >>> hiddenFile "..."+-- True+-- >>> hiddenFile "dod"+-- False+-- >>> hiddenFile "dod.bar"+-- False+hiddenFile :: RawFilePath -> Bool+hiddenFile fp+  | fp == BS.pack [_period, _period] = False+  | fp == BS.pack [_period]          = False+  | otherwise                        = BS.pack [extSeparator]+                                         `BS.isPrefixOf` 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+++------------------------+-- internal stuff++-- Just split the input FileName without adding/normalizing or changing+-- anything.+splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)+splitFileNameRaw x = BS.breakEnd isPathSeparator x++-- | Combine two paths, assuming rhs is NOT absolute.+combineRaw :: RawFilePath -> RawFilePath -> RawFilePath+combineRaw a b | BS.null a = b+                  | BS.null b = a+                  | isPathSeparator (BS.last a) = BS.append a b+                  | otherwise = BS.intercalate (BS.singleton pathSeparator) [a, b]+
+ test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CopyDirRecursiveOverwriteSpec where+++import Test.Hspec+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)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/copyDirRecursiveOverwriteSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.copyDirRecursiveOverwrite" $ do++    -- successes --+    it "copyDirRecursiveOverwrite, all fine" $ do+      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")+                                 (specDir `ba` "outputDir")+      removeDirIfExists $ specDir `ba` "outputDir"++    it "copyDirRecursiveOverwrite, all fine and compare" $ do+      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")+                                 (specDir `ba` "outputDir")+      (system $ "diff -r --no-dereference "+                          ++ specDir' ++ "inputDir" ++ " "+                          ++ specDir' ++ "outputDir")+        `shouldReturn` ExitSuccess+      removeDirIfExists $ specDir `ba` "outputDir"++    it "copyDirRecursiveOverwrite, destination dir already exists" $+      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")+                                 (specDir `ba` "alreadyExistsD")++    -- posix failures --+    it "copyDirRecursiveOverwrite, source directory does not exist" $+      copyDirRecursiveOverwrite' (specDir `ba` "doesNotExist")+                                 (specDir `ba` "outputDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyDirRecursiveOverwrite, no write permission on output dir" $+      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")+                                 (specDir `ba` "noWritePerm/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursiveOverwrite, cannot open output dir" $+      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")+                                 (specDir `ba` "noPerms/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursiveOverwrite, cannot open source dir" $+      copyDirRecursiveOverwrite' (specDir `ba` "noPerms/inputDir")+                                 (specDir `ba` "foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursiveOverwrite, destination already exists and is a file" $+      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")+                                 (specDir `ba` "alreadyExists")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyDirRecursiveOverwrite, wrong input (regular file)" $+      copyDirRecursiveOverwrite' (specDir `ba` "wrongInput")+                                 (specDir `ba` "outputDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $+      copyDirRecursiveOverwrite' (specDir `ba` "wrongInputSymL")+                                 (specDir `ba` "outputDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    -- custom failures+    it "copyDirRecursiveOverwrite, destination in source" $+      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")+                                 (specDir `ba` "inputDir/foo")+        `shouldThrow`+        isDestinationInSource++    it "copyDirRecursiveOverwrite, destination and source same directory" $+      copyDirRecursiveOverwrite' (specDir `ba` "inputDir")+                                 (specDir `ba` "inputDir")+        `shouldThrow`+        isSameFile
+ test/HPath/IO/CopyDirRecursiveSpec.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CopyDirRecursiveSpec where+++import Test.Hspec+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)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/copyDirRecursiveSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.copyDirRecursive" $ do++    -- successes --+    it "copyDirRecursive, all fine" $ do+      copyDirRecursive' (specDir `ba` "inputDir")+                        (specDir `ba` "outputDir")+      removeDirIfExists (specDir `ba` "outputDir")++    it "copyDirRecursive, all fine and compare" $ do+      copyDirRecursive' (specDir `ba` "inputDir")+                        (specDir `ba` "outputDir")+      (system $ "diff -r --no-dereference "+                          ++ specDir' ++ "inputDir" ++ " "+                          ++ specDir' ++ "outputDir")+        `shouldReturn` ExitSuccess+      removeDirIfExists (specDir `ba` "outputDir")++    -- posix failures --+    it "copyDirRecursive, source directory does not exist" $+      copyDirRecursive' (specDir `ba` "doesNotExist")+                        (specDir `ba` "outputDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyDirRecursive, no write permission on output dir" $+      copyDirRecursive' (specDir `ba` "inputDir")+                        (specDir `ba` "noWritePerm/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive, cannot open output dir" $+      copyDirRecursive' (specDir `ba` "inputDir")+                        (specDir `ba` "noPerms/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive, cannot open source dir" $+      copyDirRecursive' (specDir `ba` "noPerms/inputDir")+                        (specDir `ba` "foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive, destination dir already exists" $+      copyDirRecursive' (specDir `ba` "inputDir")+                        (specDir `ba` "alreadyExistsD")+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "copyDirRecursive, destination already exists and is a file" $+      copyDirRecursive' (specDir `ba` "inputDir")+                        (specDir `ba` "alreadyExists")+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "copyDirRecursive, wrong input (regular file)" $+      copyDirRecursive' (specDir `ba` "wrongInput")+                        (specDir `ba` "outputDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyDirRecursive, wrong input (symlink to directory)" $+      copyDirRecursive' (specDir `ba` "wrongInputSymL")+                        (specDir `ba` "outputDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    -- custom failures+    it "copyDirRecursive, destination in source" $+      copyDirRecursive' (specDir `ba` "inputDir")+                        (specDir `ba` "inputDir/foo")+        `shouldThrow`+        isDestinationInSource++    it "copyDirRecursive, destination and source same directory" $+      copyDirRecursive' (specDir `ba` "inputDir")+                        (specDir `ba` "inputDir")+        `shouldThrow`+        isSameFile
+ test/HPath/IO/CopyFileOverwriteSpec.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CopyFileOverwriteSpec where+++import Test.Hspec+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)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/copyFileOverwriteSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.copyFileOverwrite" $ do++    -- successes --+    it "copyFileOverwrite, everything clear" $ do+      copyFileOverwrite' (specDir `ba` "inputFile")+                (specDir `ba` "outputFile")+      removeFileIfExists (specDir `ba` "outputFile")++    it "copyFileOverwrite, output file already exists, all clear" $ do+      copyFile' (specDir `ba` "alreadyExists") (specDir `ba` "alreadyExists.bak")+      copyFileOverwrite' (specDir `ba` "inputFile")+                         (specDir `ba` "alreadyExists")+      (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "+                          ++ specDir' ++ "alreadyExists")+        `shouldReturn` ExitSuccess+      removeFileIfExists (specDir `ba` "alreadyExists")+      copyFile' (specDir `ba` "alreadyExists.bak") (specDir `ba` "alreadyExists")+      removeFileIfExists (specDir `ba` "alreadyExists.bak")++    it "copyFileOverwrite, and compare" $ do+      copyFileOverwrite' (specDir `ba` "inputFile")+                (specDir `ba` "outputFile")+      (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "+                          ++ specDir' ++ "outputFile")+        `shouldReturn` ExitSuccess+      removeFileIfExists (specDir `ba` "outputFile")++    -- posix failures --+    it "copyFileOverwrite, input file does not exist" $+      copyFileOverwrite' (specDir `ba` "noSuchFile")+                (specDir `ba` "outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyFileOverwrite, no permission to write to output directory" $+      copyFileOverwrite' (specDir `ba` "inputFile")+                (specDir `ba` "outputDirNoWrite/outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFileOverwrite, cannot open output directory" $+      copyFileOverwrite' (specDir `ba` "inputFile")+                (specDir `ba` "noPerms/outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFileOverwrite, cannot open source directory" $+      copyFileOverwrite' (specDir `ba` "noPerms/inputFile")+                (specDir `ba` "outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFileOverwrite, wrong input type (symlink)" $+      copyFileOverwrite' (specDir `ba` "inputFileSymL")+                (specDir `ba` "outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "copyFileOverwrite, wrong input type (directory)" $+      copyFileOverwrite' (specDir `ba` "wrongInput")+                (specDir `ba` "outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyFileOverwrite, output file already exists and is a dir" $+      copyFileOverwrite' (specDir `ba` "inputFile")+                (specDir `ba` "alreadyExistsD")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    -- custom failures --+    it "copyFileOverwrite, output and input are same file" $+      copyFileOverwrite' (specDir `ba` "inputFile")+                (specDir `ba` "inputFile")+        `shouldThrow` isSameFile
+ test/HPath/IO/CopyFileSpec.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CopyFileSpec where+++import Test.Hspec+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)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/copyFileSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.copyFile" $ do++    -- successes --+    it "copyFile, everything clear" $ do+      copyFile' (specDir `ba` "inputFile")+                (specDir `ba` "outputFile")+      removeFileIfExists (specDir `ba` "outputFile")++    it "copyFile, and compare" $ do+      copyFile' (specDir `ba` "inputFile")+                (specDir `ba` "outputFile")+      (system $ "cmp -s " ++ specDir' ++ "inputFile" ++ " "+                          ++ specDir' ++ "outputFile")+        `shouldReturn` ExitSuccess+      removeFileIfExists (specDir `ba` "outputFile")++    -- posix failures --+    it "copyFile, input file does not exist" $+      copyFile' (specDir `ba` "noSuchFile")+                (specDir `ba` "outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyFile, no permission to write to output directory" $+      copyFile' (specDir `ba` "inputFile")+                (specDir `ba` "outputDirNoWrite/outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile, cannot open output directory" $+      copyFile' (specDir `ba` "inputFile")+                (specDir `ba` "noPerms/outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile, cannot open source directory" $+      copyFile' (specDir `ba` "noPerms/inputFile")+                (specDir `ba` "outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile, wrong input type (symlink)" $+      copyFile' (specDir `ba` "inputFileSymL")+                (specDir `ba` "outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "copyFile, wrong input type (directory)" $+      copyFile' (specDir `ba` "wrongInput")+                (specDir `ba` "outputFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyFile, output file already exists" $+      copyFile' (specDir `ba` "inputFile")+                (specDir `ba` "alreadyExists")+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "copyFile, output file already exists and is a dir" $+      copyFile' (specDir `ba` "inputFile")+                (specDir `ba` "alreadyExistsD")+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    -- custom failures --+    it "copyFile, output and input are same file" $+      copyFile' (specDir `ba` "inputFile")+                (specDir `ba` "inputFile")+        `shouldThrow`+        isSameFile
+ test/HPath/IO/CreateDirSpec.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CreateDirSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/createDirSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.createDir" $ do++    -- successes --+    it "createDir, all fine" $ do+      createDir' (specDir `ba` "newDir")+      removeDirIfExists (specDir `ba` "newDir")++    -- posix failures --+    it "createDir, can't write to output directory" $+      createDir' (specDir `ba` "noWritePerms/newDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createDir, can't open output directory" $+      createDir' (specDir `ba` "noPerms/newDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createDir, destination directory already exists" $+      createDir' (specDir `ba` "alreadyExists")+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)+
+ test/HPath/IO/CreateRegularFileSpec.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CreateRegularFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/createRegularFileSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.createRegularFile" $ do++    -- successes --+    it "createRegularFile, all fine" $ do+      createRegularFile' (specDir `ba` "newDir")+      removeFileIfExists (specDir `ba` "newDir")++    -- posix failures --+    it "createRegularFile, can't write to destination directory" $+      createRegularFile' (specDir `ba` "noWritePerms/newDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createRegularFile, can't write to destination directory" $+      createRegularFile' (specDir `ba` "noPerms/newDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createRegularFile, destination file already exists" $+      createRegularFile' (specDir `ba` "alreadyExists")+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)+
+ test/HPath/IO/DeleteDirRecursiveSpec.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.DeleteDirRecursiveSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import System.Posix.Files.ByteString+  (+    getSymbolicLinkStatus+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/deleteDirRecursiveSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.deleteDirRecursive" $ do++    -- successes --+    it "deleteDirRecursive, empty directory, all fine" $ do+      createDir' (specDir `ba` "testDir")+      deleteDirRecursive' (specDir `ba` "testDir")+      getSymbolicLinkStatus (specDir `ba` "testDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteDirRecursive, empty directory with null permissions, all fine" $ do+      createDir' (specDir `ba` "noPerms/testDir")+      noPerms (specDir `ba` "noPerms/testDir")+      deleteDirRecursive' (specDir `ba` "noPerms/testDir")++    it "deleteDirRecursive, non-empty directory, all fine" $ do+      createDir' (specDir `ba` "nonEmpty")+      createDir' (specDir `ba` "nonEmpty/dir1")+      createDir' (specDir `ba` "nonEmpty/dir2")+      createDir' (specDir `ba` "nonEmpty/dir2/dir3")+      createRegularFile' (specDir `ba` "nonEmpty/file1")+      createRegularFile' (specDir `ba` "nonEmpty/dir1/file2")+      deleteDirRecursive' (specDir `ba` "nonEmpty")+      getSymbolicLinkStatus (specDir `ba` "nonEmpty")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    -- posix failures --+    it "deleteDirRecursive, can't open parent directory" $ do+      createDir' (specDir `ba` "noPerms/foo")+      noPerms (specDir `ba` "noPerms")+      (deleteDirRecursive' (specDir `ba` "noPerms/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied))+        >> normalDirPerms (specDir `ba` "noPerms")+        >> deleteDir' (specDir `ba` "noPerms/foo")++    it "deleteDirRecursive, can't write to parent directory" $ do+      createDir' (specDir `ba` "noWritable/foo")+      noWritableDirPerms (specDir `ba` "noWritable")+      (deleteDirRecursive' (specDir `ba` "noWritable/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied))+      normalDirPerms (specDir `ba` "noWritable")+      deleteDir' (specDir `ba` "noWritable/foo")++    it "deleteDirRecursive, wrong file type (symlink to directory)" $+      deleteDirRecursive' (specDir `ba` "dirSym")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteDirRecursive, wrong file type (regular file)" $+      deleteDirRecursive' (specDir `ba` "file")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteDirRecursive, directory does not exist" $+      deleteDirRecursive' (specDir `ba` "doesNotExist")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++
+ test/HPath/IO/DeleteDirSpec.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.DeleteDirSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import System.Posix.Files.ByteString+  (+    getSymbolicLinkStatus+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/deleteDirSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.deleteDir" $ do++    -- successes --+    it "deleteDir, empty directory, all fine" $ do+      createDir' (specDir `ba` "testDir")+      deleteDir' (specDir `ba` "testDir")+      getSymbolicLinkStatus (specDir `ba` "testDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteDir, directory with null permissions, all fine" $ do+      createDir' (specDir `ba` "noPerms/testDir")+      noPerms (specDir `ba` "noPerms/testDir")+      deleteDir' (specDir `ba` "noPerms/testDir")+      getSymbolicLinkStatus (specDir `ba` "testDir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    -- posix failures --+    it "deleteDir, wrong file type (symlink to directory)" $+      deleteDir' (specDir `ba` "dirSym")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteDir, wrong file type (regular file)" $+      deleteDir' (specDir `ba` "file")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteDir, directory does not exist" $+      deleteDir' (specDir `ba` "doesNotExist")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteDir, directory not empty" $+      deleteDir' (specDir `ba` "dir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == UnsatisfiedConstraints)++    it "deleteDir, can't open parent directory" $ do+      createDir' (specDir `ba` "noPerms/foo")+      noPerms (specDir `ba` "noPerms")+      (deleteDir' (specDir `ba` "noPerms/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied))+        >> normalDirPerms (specDir `ba` "noPerms")+        >> deleteDir' (specDir `ba` "noPerms/foo")++    it "deleteDir, can't write to parent directory, still fine" $ do+      createDir' (specDir `ba` "noWritable/foo")+      noWritableDirPerms (specDir `ba` "noWritable")+      (deleteDir' (specDir `ba` "noWritable/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied))+      normalDirPerms (specDir `ba` "noWritable")+      deleteDir' (specDir `ba` "noWritable/foo")+++
+ test/HPath/IO/DeleteFileSpec.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.DeleteFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import System.Posix.Files.ByteString+  (+    getSymbolicLinkStatus+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/deleteFileSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.deleteFile" $ do++    -- successes --+    it "deleteFile, regular file, all fine" $ do+      createRegularFile' (specDir `ba` "testFile")+      deleteFile' (specDir `ba` "testFile")+      getSymbolicLinkStatus (specDir `ba` "testFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteFile, symlink, all fine" $ do+      recreateSymlink' (specDir `ba` "syml")+                       (specDir `ba` "testFile")+      deleteFile' (specDir `ba` "testFile")+      getSymbolicLinkStatus (specDir `ba` "testFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    -- posix failures --+    it "deleteFile, wrong file type (directory)" $+      deleteFile' (specDir `ba` "dir")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteFile, file does not exist" $+      deleteFile' (specDir `ba` "doesNotExist")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteFile, can't read directory" $+      deleteFile' (specDir `ba` "noPerms/blah")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+
+ test/HPath/IO/GetDirsFilesSpec.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.GetDirsFilesSpec where+++import Control.Applicative+  (+    (<$>)+  )+import Data.List+  (+    sort+  )+import Data.Maybe+  (+    fromJust+  )+import qualified HPath as P+import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import System.Posix.Env.ByteString+  (+    getEnv+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/getDirsFilesSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.getDirsFiles" $ do++    -- successes --+    it "getDirsFiles, all fine" $ do+      pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs+      expectedFiles <- mapM P.parseRel [(specDir `ba ` ".hidden")+                                       ,(specDir `ba ` "Lala")+                                       ,(specDir `ba ` "dir")+                                       ,(specDir `ba ` "dirsym")+                                       ,(specDir `ba ` "file")+                                       ,(specDir `ba ` "noPerms")+                                       ,(specDir `ba ` "syml")]+      (fmap sort $ getDirsFiles' specDir)+        `shouldReturn` fmap (pwd P.</>) expectedFiles++    -- posix failures --+    it "getDirsFiles, nonexistent directory" $+      getDirsFiles' (specDir `ba ` "nothingHere")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "getDirsFiles, wrong file type (file)" $+      getDirsFiles' (specDir `ba ` "file")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "getDirsFiles, wrong file type (symlink to file)" $+      getDirsFiles' (specDir `ba ` "syml")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "getDirsFiles, wrong file type (symlink to dir)" $+      getDirsFiles' (specDir `ba ` "dirsym")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "getDirsFiles, can't open directory" $+      getDirsFiles' (specDir `ba ` "noPerms")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++++
+ test/HPath/IO/GetFileTypeSpec.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.GetFileTypeSpec where+++import HPath.IO+import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/getFileTypeSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.getFileType" $ do++    -- successes --+    it "getFileType, regular file" $+      getFileType' (specDir `ba` "regularfile")+        `shouldReturn` RegularFile++    it "getFileType, directory" $+      getFileType' (specDir `ba` "directory")+        `shouldReturn` Directory++    it "getFileType, directory with null permissions" $+      getFileType' (specDir `ba` "noPerms")+        `shouldReturn` Directory++    it "getFileType, symlink to file" $+      getFileType' (specDir `ba` "symlink")+        `shouldReturn` SymbolicLink++    it "getFileType, symlink to directory" $+      getFileType' (specDir `ba` "symlinkD")+        `shouldReturn` SymbolicLink++    it "getFileType, broken symlink" $+      getFileType' (specDir `ba` "brokenSymlink")+        `shouldReturn` SymbolicLink++    -- posix failures --+    it "getFileType, file does not exist" $+      getFileType' (specDir `ba` "nothingHere")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "getFileType, can't open directory" $+      getFileType' (specDir `ba` "noPerms/forz")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+
+ test/HPath/IO/MoveFileOverwriteSpec.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.MoveFileOverwriteSpec where+++import Test.Hspec+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/moveFileOverwriteSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.moveFileOverwrite" $ do++    -- successes --+    it "moveFileOverwrite, all fine" $+      moveFileOverwrite' (specDir `ba` "myFile")+                         (specDir `ba` "movedFile")++    it "moveFileOverwrite, all fine" $+      moveFileOverwrite' (specDir `ba` "myFile")+                         (specDir `ba` "dir/movedFile")++    it "moveFileOverwrite, all fine on symlink" $+      moveFileOverwrite' (specDir `ba` "myFileL")+                         (specDir `ba` "movedFile")++    it "moveFileOverwrite, all fine on directory" $+      moveFileOverwrite' (specDir `ba` "dir")+                         (specDir `ba` "movedFile")++    it "moveFileOverwrite, destination file already exists" $+      moveFileOverwrite' (specDir `ba` "myFile")+                         (specDir `ba` "alreadyExists")++    -- posix failures --+    it "moveFileOverwrite, source file does not exist" $+      moveFileOverwrite' (specDir `ba` "fileDoesNotExist")+                         (specDir `ba` "movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "moveFileOverwrite, can't write to destination directory" $+      moveFileOverwrite' (specDir `ba` "myFile")+                         (specDir `ba` "noWritePerm/movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "moveFileOverwrite, can't open destination directory" $+      moveFileOverwrite' (specDir `ba` "myFile")+                         (specDir `ba` "noPerms/movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "moveFileOverwrite, can't open source directory" $+      moveFileOverwrite' (specDir `ba` "noPerms/myFile")+                         (specDir `ba` "movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    -- 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" $+      moveFileOverwrite' (specDir `ba` "myFile")+                         (specDir `ba` "myFile")+        `shouldThrow`+        isSameFile+
+ test/HPath/IO/MoveFileSpec.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.MoveFileSpec where+++import Test.Hspec+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/moveFileSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.moveFile" $ do++    -- successes --+    it "moveFile, all fine" $+      moveFile' (specDir `ba` "myFile")+                (specDir `ba` "movedFile")++    it "moveFile, all fine" $+      moveFile' (specDir `ba` "myFile")+                (specDir `ba` "dir/movedFile")++    it "moveFile, all fine on symlink" $+      moveFile' (specDir `ba` "myFileL")+                (specDir `ba` "movedFile")++    it "moveFile, all fine on directory" $+      moveFile' (specDir `ba` "dir")+                (specDir `ba` "movedFile")++    -- posix failures --+    it "moveFile, source file does not exist" $+      moveFile' (specDir `ba` "fileDoesNotExist")+                (specDir `ba` "movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "moveFile, can't write to destination directory" $+      moveFile' (specDir `ba` "myFile")+                (specDir `ba` "noWritePerm/movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "moveFile, can't open destination directory" $+      moveFile' (specDir `ba` "myFile")+                (specDir `ba` "noPerms/movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "moveFile, can't open source directory" $+      moveFile' (specDir `ba` "noPerms/myFile")+                (specDir `ba` "movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    -- custom failures --+    it "moveFile, destination file already exists" $+      moveFile' (specDir `ba` "myFile")+                (specDir `ba` "alreadyExists")+        `shouldThrow`+        isFileDoesExist++    it "moveFile, move from file to dir" $+      moveFile' (specDir `ba` "myFile")+                (specDir `ba` "alreadyExistsD")+        `shouldThrow`+        isDirDoesExist++    it "moveFile, source and dest are same file" $+      moveFile' (specDir `ba` "myFile")+                (specDir `ba` "myFile")+        `shouldThrow`+        isSameFile+
+ test/HPath/IO/RecreateSymlinkSpec.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.RecreateSymlinkSpec where+++import Test.Hspec+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/recreateSymlinkSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.recreateSymlink" $ do++    -- successes --+    it "recreateSymLink, all fine" $ do+      recreateSymlink' (specDir `ba` "myFileL")+                       (specDir `ba` "movedFile")+      removeFileIfExists (specDir `ba` "movedFile")++    it "recreateSymLink, all fine" $ do+      recreateSymlink' (specDir `ba` "myFileL")+                       (specDir `ba` "dir/movedFile")+      removeFileIfExists (specDir `ba` "dir/movedFile")++    -- posix failures --+    it "recreateSymLink, wrong input type (file)" $+      recreateSymlink' (specDir `ba` "myFile")+                       (specDir `ba` "movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "recreateSymLink, wrong input type (directory)" $+      recreateSymlink' (specDir `ba` "dir")+                       (specDir `ba` "movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "recreateSymLink, can't write to destination directory" $+      recreateSymlink' (specDir `ba` "myFileL")+                       (specDir `ba` "noWritePerm/movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "recreateSymLink, can't open destination directory" $+      recreateSymlink' (specDir `ba` "myFileL")+                       (specDir `ba` "noPerms/movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "recreateSymLink, can't open source directory" $+      recreateSymlink' (specDir `ba` "noPerms/myFileL")+                       (specDir `ba` "movedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "recreateSymLink, destination file already exists" $+      recreateSymlink' (specDir `ba` "myFileL")+                       (specDir `ba` "alreadyExists")+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "recreateSymLink, destination already exists and is a dir" $+      recreateSymlink' (specDir `ba` "myFileL")+                       (specDir `ba` "alreadyExistsD")+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    -- custom failures --+    it "recreateSymLink, source and destination are the same file" $+      recreateSymlink' (specDir `ba` "myFileL")+                       (specDir `ba` "myFileL")+        `shouldThrow`+        isSameFile+
+ test/HPath/IO/RenameFileSpec.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.RenameFileSpec where+++import Test.Hspec+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+import qualified Data.ByteString as BS+import           Data.ByteString.UTF8 (toString)+++ba :: BS.ByteString -> BS.ByteString -> BS.ByteString+ba = BS.append++specDir :: BS.ByteString+specDir = "test/HPath/IO/renameFileSpec/"++specDir' :: String+specDir' = toString specDir+++spec :: Spec+spec =+  describe "HPath.IO.renameFile" $ do++    -- successes --+    it "renameFile, all fine" $+      renameFile' (specDir `ba` "myFile")+                  (specDir `ba` "renamedFile")++    it "renameFile, all fine" $+      renameFile' (specDir `ba` "myFile")+                  (specDir `ba` "dir/renamedFile")++    it "renameFile, all fine on symlink" $+      renameFile' (specDir `ba` "myFileL")+                  (specDir `ba` "renamedFile")++    it "renameFile, all fine on directory" $+      renameFile' (specDir `ba` "dir")+                  (specDir `ba` "renamedFile")++    -- posix failures --+    it "renameFile, source file does not exist" $+      renameFile' (specDir `ba` "fileDoesNotExist")+                  (specDir `ba` "renamedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "renameFile, can't write to output directory" $+      renameFile' (specDir `ba` "myFile")+                  (specDir `ba` "noWritePerm/renamedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "renameFile, can't open output directory" $+      renameFile' (specDir `ba` "myFile")+                  (specDir `ba` "noPerms/renamedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "renameFile, can't open source directory" $+      renameFile' (specDir `ba` "noPerms/myFile")+                  (specDir `ba` "renamedFile")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    -- custom failures --+    it "renameFile, destination file already exists" $+      renameFile' (specDir `ba` "myFile")+                  (specDir `ba` "alreadyExists")+        `shouldThrow`+        isFileDoesExist++    it "renameFile, move from file to dir" $+      renameFile' (specDir `ba` "myFile")+                  (specDir `ba` "alreadyExistsD")+        `shouldThrow`+        isDirDoesExist++    it "renameFile, source and dest are same file" $+      renameFile' (specDir `ba` "myFile")+                  (specDir `ba` "myFile")+        `shouldThrow`+        isSameFile+
+ test/Main.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++import Test.Hspec+import Test.Hspec.Runner+import Test.Hspec.Formatters+import qualified Spec+import Utils+++-- TODO: chardev, blockdev, namedpipe, socket+++main :: IO ()+main =+  hspecWith+    defaultConfig { configFormatter = Just progress }+    $ before_ fixPermissions+    $ after_ revertPermissions+    $ Spec.spec >> Spec.spec+  where+    noWriteDirs =  ["test/HPath/IO/copyFileSpec/outputDirNoWrite"+                   ,"test/HPath/IO/copyFileOverwriteSpec/outputDirNoWrite"+                   ,"test/HPath/IO/copyDirRecursiveSpec/noWritePerm"+                   ,"test/HPath/IO/copyDirRecursiveOverwriteSpec/noWritePerm"+                   ,"test/HPath/IO/createDirSpec/noWritePerms"+                   ,"test/HPath/IO/createRegularFileSpec/noWritePerms"+                   ,"test/HPath/IO/renameFileSpec/noWritePerm"+                   ,"test/HPath/IO/moveFileSpec/noWritePerm"+                   ,"test/HPath/IO/moveFileOverwriteSpec/noWritePerm"+                   ,"test/HPath/IO/recreateSymlinkSpec/noWritePerm"+                   ]+    noPermsDirs =  ["test/HPath/IO/copyFileSpec/noPerms"+                   ,"test/HPath/IO/copyFileOverwriteSpec/noPerms"+                   ,"test/HPath/IO/copyDirRecursiveSpec/noPerms"+                   ,"test/HPath/IO/copyDirRecursiveOverwriteSpec/noPerms"+                   ,"test/HPath/IO/createDirSpec/noPerms"+                   ,"test/HPath/IO/createRegularFileSpec/noPerms"+                   ,"test/HPath/IO/renameFileSpec/noPerms"+                   ,"test/HPath/IO/moveFileSpec/noPerms"+                   ,"test/HPath/IO/moveFileOverwriteSpec/noPerms"+                   ,"test/HPath/IO/recreateSymlinkSpec/noPerms"+                   ,"test/HPath/IO/getFileTypeSpec/noPerms"+                   ,"test/HPath/IO/getDirsFilesSpec/noPerms"+                   ,"test/HPath/IO/deleteFileSpec/noPerms"+                   ]+    fixPermissions = do+      sequence_ $ fmap noWritableDirPerms noWriteDirs+      sequence_ $ fmap noPerms noPermsDirs+    revertPermissions = do+      sequence_ $ fmap normalDirPerms noWriteDirs+      sequence_ $ fmap normalDirPerms noPermsDirs++
+ test/Spec.hs view
@@ -0,0 +1,2 @@+-- file test/Spec.hs+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}
+ test/Utils.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE OverloadedStrings #-}++module Utils where+++import Control.Applicative+  (+    (<$>)+  )+import HPath.IO+import HPath.IO.Errors+import HPath.IO.Utils+import Data.Maybe+  (+    fromJust+  )+import qualified HPath as P+import System.Posix.Env.ByteString+  (+    getEnv+  )+import Data.ByteString+  (+    ByteString+  )+import System.Posix.Files.ByteString+  (+    groupExecuteMode+  , groupReadMode+  , nullFileMode+  , otherExecuteMode+  , otherReadMode+  , ownerExecuteMode+  , ownerReadMode+  , setFileMode+  , unionFileModes+  )++++    -----------------+    --[ Utilities ]--+    -----------------+++withPwd :: ByteString -> (P.Path P.Abs -> IO a) -> IO a+withPwd ip f = do+  pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs+  p <- (pwd P.</>) <$> P.parseRel ip+  f p+++withPwd' :: ByteString+         -> ByteString+         -> (P.Path P.Abs -> P.Path P.Abs -> IO a)+         -> IO a+withPwd' ip1 ip2 f = do+  pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs+  p1 <- (pwd P.</>) <$> P.parseRel ip1+  p2 <- (pwd P.</>) <$> P.parseRel ip2+  f p1 p2+++removeFileIfExists :: ByteString -> IO ()+removeFileIfExists bs =+  withPwd bs $ \p -> whenM (doesFileExist p) (deleteFile p)+++removeDirIfExists :: ByteString -> IO ()+removeDirIfExists bs =+  withPwd bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)+++copyFile' :: ByteString -> ByteString -> IO ()+copyFile' inputFileP outputFileP =+  withPwd' inputFileP outputFileP copyFile+++copyFileOverwrite' :: ByteString -> ByteString -> IO ()+copyFileOverwrite' inputFileP outputFileP =+  withPwd' inputFileP outputFileP copyFileOverwrite+++copyDirRecursive' :: ByteString -> ByteString -> IO ()+copyDirRecursive' inputDirP outputDirP =+  withPwd' inputDirP outputDirP copyDirRecursive+++copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO ()+copyDirRecursiveOverwrite' inputDirP outputDirP =+  withPwd' inputDirP outputDirP copyDirRecursiveOverwrite+++createDir' :: ByteString -> IO ()+createDir' dest = withPwd dest createDir+++createRegularFile' :: ByteString -> IO ()+createRegularFile' dest = withPwd dest createRegularFile+++renameFile' :: ByteString -> ByteString -> IO ()+renameFile' inputFileP outputFileP =+  withPwd' inputFileP outputFileP $ \i o -> do+    renameFile i o+    renameFile o i+++moveFile' :: ByteString -> ByteString -> IO ()+moveFile' inputFileP outputFileP =+  withPwd' inputFileP outputFileP $ \i o -> do+    moveFile i o+    moveFile o i+++moveFileOverwrite' :: ByteString -> ByteString -> IO ()+moveFileOverwrite' inputFileP outputFileP =+  withPwd' inputFileP outputFileP $ \i o -> do+    moveFileOverwrite i o+    moveFile o i+++recreateSymlink' :: ByteString -> ByteString -> IO ()+recreateSymlink' inputFileP outputFileP =+  withPwd' inputFileP outputFileP recreateSymlink+++noWritableDirPerms :: ByteString -> IO ()+noWritableDirPerms path = withPwd path $ \p ->+  setFileMode (P.fromAbs p) perms+  where+    perms =            ownerReadMode+      `unionFileModes` ownerExecuteMode+      `unionFileModes` groupReadMode+      `unionFileModes` groupExecuteMode+      `unionFileModes` otherReadMode+      `unionFileModes` otherExecuteMode+++noPerms :: ByteString -> IO ()+noPerms path = withPwd path $ \p -> setFileMode (P.fromAbs p) nullFileMode+++normalDirPerms :: ByteString -> IO ()+normalDirPerms path =+  withPwd path $ \p -> setFileMode (P.fromAbs p) newDirPerms+++getFileType' :: ByteString -> IO FileType+getFileType' path = withPwd path getFileType+++getDirsFiles' :: ByteString -> IO [P.Path P.Abs]+getDirsFiles' path = withPwd path getDirsFiles+++deleteFile' :: ByteString -> IO ()+deleteFile' p = withPwd p deleteFile+++deleteDir' :: ByteString -> IO ()+deleteDir' p = withPwd p deleteDir+++deleteDirRecursive' :: ByteString -> IO ()+deleteDirRecursive' p = withPwd p deleteDirRecursive+++canonicalizePath' :: ByteString -> IO (P.Path P.Abs)+canonicalizePath' p = withPwd p canonicalizePath+