packages feed

hpath-io (empty) → 0.10.0

raw patch · 41 files changed

+5186/−0 lines, 41 filesdep +HUnitdep +IfElsedep +basesetup-changed

Dependencies added: HUnit, IfElse, base, bytestring, hpath, hpath-filepath, hpath-io, hspec, process, streamly, unbuildable, unix, unix-bytestring, utf8-string

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for hpath-io++## 0.9.3 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2020, Julian Ospald++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Julian Ospald nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,26 @@+# HPath-IO++[![Gitter chat](https://badges.gitter.im/Join%20Chat.svg)](https://gitter.im/hasufell/hpath?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) [![Hackage version](https://img.shields.io/hackage/v/hpath-io.svg?label=Hackage)](https://hackage.haskell.org/package/hpath-io) [![Build Status](https://api.travis-ci.org/hasufell/hpath.png?branch=master)](http://travis-ci.org/hasufell/hpath) [![Hackage-Deps](https://img.shields.io/hackage-deps/v/hpath-io.svg)](http://packdeps.haskellers.com/feed?needle=hpath-io)++High-level IO operations on files/directories, utilizing type-safe Paths.++## Motivation++The motivation came during development of+[hsfm](https://github.com/hasufell/hsfm)+in order to have a proper high-level API of file related operations,+while utilizing type-safe Paths.++## Goals++* high-level API to file operations like recursive directory copy+* still allowing sufficient control to interact with the underlying low-level calls+* unit-testing exceptions (because yes, people may rely on them)++Note: this library was written for __posix__ systems and it will probably not support other systems.++## Differences to 'posix-paths'++* has a custom versions of `openFd` which allows more control over the flags than its unix package counterpart+* adds a `getDirectoryContents'` version that works on Fd+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ 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
+ hpath-io.cabal view
@@ -0,0 +1,100 @@+name:                hpath-io+version:             0.10.0+synopsis:            High-level IO operations on files/directories+description:         High-level IO operations on files/directories, utilizing type-safe Paths+-- bug-reports:+license:             BSD3+license-file:        LICENSE+author:              Julian Ospald <hasufell@posteo.de>+maintainer:          Julian Ospald <hasufell@posteo.de>+copyright:           Julian Ospald 2016+category:            Filesystem+build-type:          Simple+cabal-version:       1.14+tested-with:         GHC==7.10.3+                   , GHC==8.0.2+                   , GHC==8.2.2+                   , GHC==8.4.4+                   , GHC==8.6.5+                   , GHC==8.8.1+extra-source-files:  README.md+                     CHANGELOG.md+                     cbits/dirutils.h++library+  if os(windows)+    build-depends: unbuildable<0+    buildable: False+  exposed-modules:   HPath.IO,+                     HPath.IO.Errors,+                     System.Posix.Directory.Foreign,+                     System.Posix.Directory.Traversals,+                     System.Posix.FD+  c-sources:         cbits/dirutils.c++  -- other-modules:+  -- other-extensions:+  build-depends:     base >= 4.8 && <5+                   , IfElse+                   , bytestring >= 0.10.0.0+                   , hpath >= 0.10 && < 0.11+                   , hpath-filepath >= 0.10 && < 0.11+                   , streamly >= 0.7+                   , unix >= 2.5+                   , unix-bytestring+                   , utf8-string+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite spec+  if os(windows)+    build-depends: unbuildable<0+    buildable: False+  Type:                 exitcode-stdio-1.0+  Default-Language:     Haskell2010+  Hs-Source-Dirs:       test+  Main-Is:              Main.hs+  other-modules:+                        HPath.IO.AppendFileSpec+                        HPath.IO.CanonicalizePathSpec+                        HPath.IO.CopyDirRecursiveCollectFailuresSpec+                        HPath.IO.CopyDirRecursiveOverwriteSpec+                        HPath.IO.CopyDirRecursiveSpec+                        HPath.IO.CopyFileOverwriteSpec+                        HPath.IO.CopyFileSpec+                        HPath.IO.CreateDirRecursiveSpec+                        HPath.IO.CreateDirSpec+                        HPath.IO.CreateRegularFileSpec+                        HPath.IO.CreateSymlinkSpec+                        HPath.IO.DeleteDirRecursiveSpec+                        HPath.IO.DeleteDirSpec+                        HPath.IO.DeleteFileSpec+                        HPath.IO.GetDirsFilesSpec+                        HPath.IO.GetFileTypeSpec+                        HPath.IO.MoveFileOverwriteSpec+                        HPath.IO.MoveFileSpec+                        HPath.IO.ReadFileEOFSpec+                        HPath.IO.ReadFileSpec+                        HPath.IO.RecreateSymlinkOverwriteSpec+                        HPath.IO.RecreateSymlinkSpec+                        HPath.IO.RenameFileSpec+                        HPath.IO.ToAbsSpec+                        HPath.IO.WriteFileSpec+                        Spec+                        Utils+  GHC-Options:          -Wall+  Build-Depends:        base+                      , HUnit+                      , IfElse+                      , bytestring >= 0.10.0.0+                      , hpath+                      , hpath-io+                      , hspec >= 1.3+                      , process+                      , unix+                      , unix-bytestring+                      , utf8-string++source-repository head+  type:     git+  location: https://github.com/hasufell/hpath
+ src/HPath/IO.hs view
@@ -0,0 +1,1075 @@+-- |+-- Module      :  HPath.IO+-- Copyright   :  © 2016 Julian Ospald+-- License     :  BSD3+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- This module provides high-level IO related file operations like+-- copy, delete, move and so on. It only operates on /Path x/ which+-- guarantees us well-typed paths. Passing in /Path Abs/ to any+-- of these functions generally increases safety. Passing /Path Rel/+-- may trigger looking up the current directory via `getcwd` in some+-- cases where it cannot be avoided.+--+-- 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 ignored by some of the more high-level functions (like `easyCopy`).+-- For other functions (like `copyFile`), the behavior on these file types is+-- unreliable/unsafe. Check the documentation of those functions for details.++{-# LANGUAGE CPP #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO+  (+  -- * Types+    FileType(..)+  , RecursiveErrorMode(..)+  , CopyMode(..)+  -- * File copying+  , copyDirRecursive+  , recreateSymlink+  , copyFile+  , easyCopy+  -- * File deletion+  , deleteFile+  , deleteDir+  , deleteDirRecursive+  , easyDelete+  -- * File opening+  , openFile+  , executeFile+  -- * File creation+  , createRegularFile+  , createDir+  , createDirRecursive+  , createSymlink+  -- * File renaming/moving+  , renameFile+  , moveFile+  -- * File reading+  , readFile+  , readFileEOF+  -- * File writing+  , writeFile+  , appendFile+  -- * File permissions+  , newFilePerms+  , newDirPerms+  -- * Directory reading+  , getDirsFiles+  -- * Filetype operations+  , getFileType+  -- * Others+  , canonicalizePath+  , toAbs+  )+  where+++import Control.Applicative+  (+    (<$>)+  )+import Control.Exception+  (+    IOException+  , bracket+  , throwIO+  )+import Control.Monad+  (+    unless+  , void+  , when+  )+import Control.Monad.IfElse+  (+    unlessM+  )+import Data.ByteString+  (+    ByteString+  )+#if MIN_VERSION_bytestring(0,10,2)+import Data.ByteString.Builder+#else+import Data.ByteString.Lazy.Builder+#endif+  (+    Builder+  , byteString+  , toLazyByteString+  )+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Unsafe+  (+    unsafePackCStringFinalizer+  )+import Data.Foldable+  (+    for_+  )+import Data.IORef+  (+    IORef+  , modifyIORef+  , newIORef+  , readIORef+  )+import Data.Maybe+  (+    catMaybes+  )+import Data.Monoid+  (+    (<>)+  , mempty+  )+import Data.Word+  (+    Word8+  )+import Foreign.C.Error+  (+    eEXIST+  , eNOENT+  , eNOTEMPTY+  , eXDEV+  , getErrno+  )+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 Prelude hiding (appendFile, readFile, writeFile)+import qualified Streamly.FileSystem.Handle as FH+import qualified Streamly.Internal.FileSystem.Handle as IFH+import qualified Streamly.Prelude as S+import qualified System.IO as SIO+import System.IO.Error+  (+    catchIOError+  , ioeGetErrorType+  )+import System.Posix.ByteString+  (+    exclusive+  )+import System.Posix.Directory.ByteString+  (+    createDirectory+  , getWorkingDirectory+  , 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 System.Posix.FD+  (+    openFd+  )+import qualified System.Posix.Directory.Traversals as SPDT+import qualified System.Posix.Directory.Foreign as SPDF+import qualified System.Posix.Process.ByteString as SPP+import System.Posix.Types+  (+    FileMode+  , ProcessID+  , Fd+  )++++++    -------------+    --[ Types ]--+    -------------+++data FileType = Directory+              | RegularFile+              | SymbolicLink+              | BlockDevice+              | CharacterDevice+              | NamedPipe+              | Socket+  deriving (Eq, Show)++++-- |The error mode for recursive operations.+--+-- On `FailEarly` the whole operation fails immediately if any of the+-- recursive sub-operations fail, which is sort of the default+-- for IO operations.+--+-- On `CollectFailures` skips errors in the recursion and keeps on recursing.+-- However all errors are collected in the `RecursiveFailure` error type,+-- which is raised finally if there was any error. Also note that+-- `RecursiveFailure` does not give any guarantees on the ordering+-- of the collected exceptions.+data RecursiveErrorMode = FailEarly+                        | CollectFailures+++-- |The mode for copy and file moves.+-- Overwrite mode is usually not very well defined, but is a convenience+-- shortcut.+data CopyMode = Strict    -- ^ fail if any target exists+              | Overwrite -- ^ overwrite targets+++++    --------------------+    --[ File Copying ]--+    --------------------++++-- |Copies the contents of a directory recursively to the given destination, while preserving permissions.+-- Does not follow symbolic links. This behaves more or less like+-- the following, without descending into the destination if it+-- already exists:+--+-- @+--   cp -a \/source\/dir \/destination\/somedir+-- @+--+-- For directory contents, this will ignore any file type that is not+-- `RegularFile`, `SymbolicLink` or `Directory`.+--+-- For `Overwrite` copy mode this does not prune destination directory+-- contents, so the destination might contain more files than the source after+-- the operation has completed. Permissions of existing directories are+-- fixed.+--+-- Safety/reliability concerns:+--+--    * not atomic+--    * examines filetypes explicitly+--    * an explicit check `throwDestinationInSource` is carried out for the+--      top directory for basic sanity, because otherwise we might end up+--      with an infinite copy loop... however, this operation is not+--      carried out recursively (because it's slow)+--+-- Throws:+--+--    - `NoSuchThing` if source directory does not exist+--    - `PermissionDenied` if source directory can't be opened+--    - `SameFile` if source and destination are the same file+--      (`HPathIOException`)+--    - `DestinationInSource` if destination is contained in source+--      (`HPathIOException`)+--+-- Throws in `FailEarly` RecursiveErrorMode only:+--+--    - `PermissionDenied` if output directory is not writable+--    - `InvalidArgument` if source directory is wrong type (symlink)+--    - `InappropriateType` if source directory is wrong type (regular file)+--+-- Throws in `CollectFailures` RecursiveErrorMode only:+--+--    - `RecursiveFailure` if any of the recursive operations that are not+--      part of the top-directory sanity-checks fail (`HPathIOException`)+--+-- Throws in `Strict` CopyMode only:+--+--    - `AlreadyExists` if destination already exists+--+-- Note: may call `getcwd` (only if destination is a relative path)+copyDirRecursive :: Path b1  -- ^ source dir+                 -> Path b2  -- ^ destination (parent dirs+                             --   are not automatically created)+                 -> CopyMode+                 -> RecursiveErrorMode+                 -> IO ()+copyDirRecursive fromp destdirp cm rm+  = do+    ce <- newIORef []+    -- for performance, sanity checks are only done for the top dir+    throwSameFile fromp destdirp+    throwDestinationInSource fromp destdirp+    go ce fromp destdirp+    collectedExceptions <- readIORef ce+    unless (null collectedExceptions)+           (throwIO . RecursiveFailure $ collectedExceptions)+  where+    go :: IORef [(RecursiveFailureHint, IOException)]+       -> Path b1 -> Path b2 -> IO ()+    go ce fromp'@(MkPath fromBS) destdirp'@(MkPath destdirpBS) = do++      -- NOTE: order is important here, so we don't get empty directories+      -- on failure++      -- get the contents of the source dir+      contents <- handleIOE (ReadContentsFailed fromBS destdirpBS) ce [] $ do+        contents <- getDirsFiles fromp'++        -- create the destination dir and+        -- only return contents if we succeed+        handleIOE (CreateDirFailed fromBS destdirpBS) ce [] $ do+          fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus fromBS+          case cm of+            Strict    -> createDirectory destdirpBS fmode'+            Overwrite -> catchIOError (createDirectory destdirpBS+                                                       fmode')+                           $ \e ->+                             case ioeGetErrorType e of+                               AlreadyExists -> setFileMode destdirpBS+                                                            fmode'+                               _             -> ioError e+          return contents++      -- NOTE: we can't use `easyCopy` here, because we want to call `go`+      -- recursively to skip the top-level sanity checks++      -- if reading the contents and creating the destination dir worked,+      -- then copy the contents to the destination too+      for_ contents $ \f -> do+        ftype <- getFileType f+        newdest <- (destdirp' </>) <$> basename f+        case ftype of+          SymbolicLink -> handleIOE (RecreateSymlinkFailed (toFilePath f) (toFilePath newdest)) ce ()+                            $ recreateSymlink f newdest cm+          Directory    -> go ce f newdest+          RegularFile  -> handleIOE (CopyFileFailed (toFilePath f) (toFilePath newdest)) ce ()+                            $ copyFile f newdest cm+          _            -> return ()++    -- helper to handle errors for both RecursiveErrorModes and return a+    -- default value+    handleIOE :: RecursiveFailureHint+              -> IORef [(RecursiveFailureHint, IOException)]+              -> a -> IO a -> IO a+    handleIOE hint ce def = case rm of+      FailEarly       -> handleIOError throwIO+      CollectFailures -> handleIOError (\e -> modifyIORef ce ((hint, e):)+                                         >> return def)+++-- |Recreate a symlink.+--+-- In `Overwrite` copy mode only files and empty directories are deleted.+--+-- Safety/reliability concerns:+--+--    * `Overwrite` mode is inherently non-atomic+--+-- Throws:+--+--    - `InvalidArgument` if source file is wrong type (not a symlink)+--    - `PermissionDenied` if output directory cannot be written to+--    - `PermissionDenied` if source directory cannot be opened+--    - `SameFile` if source and destination are the same file+--      (`HPathIOException`)+--+--+-- Throws in `Strict` mode only:+--+--    - `AlreadyExists` if destination already exists+--+-- Throws in `Overwrite` mode only:+--+--    - `UnsatisfiedConstraints` if destination file is non-empty directory+--+-- Notes:+--+--    - calls `symlink`+--    - calls `getcwd` in Overwrite mode (if destination is a relative path)+recreateSymlink :: Path b1   -- ^ the old symlink file+                -> Path b2   -- ^ destination file+                -> CopyMode+                -> IO ()+recreateSymlink symsource@(MkPath symsourceBS) newsym@(MkPath newsymBS) cm+  = do+    throwSameFile symsource newsym+    sympoint <- readSymbolicLink symsourceBS+    case cm of+      Strict -> return ()+      Overwrite -> do+        writable <- toAbs newsym >>= isWritable+        isfile   <- doesFileExist newsym+        isdir    <- doesDirectoryExist newsym+        when (writable && isfile) (deleteFile newsym)+        when (writable && isdir)  (deleteDir newsym)+    createSymbolicLink sympoint newsymBS+++-- |Copies the given regular file to the given destination.+-- Neither follows symbolic links, nor accepts them.+-- For "copying" symbolic links, use `recreateSymlink` instead.+--+-- Note that this is still sort of a low-level function and doesn't+-- examine file types. For a more high-level version, use `easyCopy`+-- instead.+--+-- In `Overwrite` copy mode only overwrites actual files, not directories.+-- In `Strict` mode the destination file must not exist.+--+-- Safety/reliability concerns:+--+--    * `Overwrite` mode is not atomic+--    * when used on `CharacterDevice`, reads the "contents" and copies+--      them to a regular file, which might take indefinitely+--    * when used on `BlockDevice`, may either read the "contents"+--      and copy them to a regular file (potentially hanging indefinitely)+--      or may create a regular empty destination file+--    * when used on `NamedPipe`, will hang indefinitely+--+-- Throws:+--+--    - `NoSuchThing` if source file does not exist+--    - `NoSuchThing` if source file is a a `Socket`+--    - `PermissionDenied` if output directory is not writable+--    - `PermissionDenied` if source directory can't be opened+--    - `InvalidArgument` if source file is wrong type (symlink or directory)+--    - `SameFile` if source and destination are the same file+--      (`HPathIOException`)+--+-- Throws in `Strict` mode only:+--+--    - `AlreadyExists` if destination already exists+--+-- Notes:+--+--    - may call `getcwd` in Overwrite mode (if destination is a relative path)+copyFile :: Path b1   -- ^ source file+         -> Path b2   -- ^ destination file+         -> CopyMode+         -> IO ()+copyFile fp@(MkPath from) tp@(MkPath to) cm = do+  throwSameFile fp tp+  bracket (do+            fd <- openFd from SPI.ReadOnly [SPDF.oNofollow] Nothing+            handle <- SPI.fdToHandle fd+            pure (fd, handle))+    (\(_, handle) -> SIO.hClose handle)+    $ \(fromFd, fH) -> do+                   sourceFileMode <- System.Posix.Files.ByteString.fileMode <$> getFdStatus fromFd+                   let dflags = [SPDF.oNofollow, case cm of+                                                      Strict    -> SPDF.oExcl+                                                      Overwrite -> SPDF.oTrunc]+                   bracketeer (do+                                fd <- openFd to SPI.WriteOnly dflags $ Just sourceFileMode+                                handle <- SPI.fdToHandle fd+                                pure (fd, handle))+                              (\(_, handle) -> SIO.hClose handle)+                              (\(_, handle) -> do+                                                 SIO.hClose handle+                                                 case cm of+                                                      -- if we created the file and copying failed, it's+                                                      -- safe to clean up+                                                      Strict -> deleteFile tp+                                                      Overwrite -> pure ())+                              $ \(_, tH) -> do+                                           SIO.hSetBinaryMode fH True+                                           SIO.hSetBinaryMode tH True+                                           streamlyCopy (fH, tH)+  where+    streamlyCopy (fH, tH) = S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256*1024) fH++-- |Copies a regular file, directory or symbolic link. In case of a+-- symbolic link it is just recreated, even if it points to a directory.+-- Any other file type is ignored.+--+-- Safety/reliability concerns:+--+--    * examines filetypes explicitly+--    * calls `copyDirRecursive` for directories+--+-- Note: may call `getcwd` in Overwrite mode (if destination is a relative path)+easyCopy :: Path b1+         -> Path b2+         -> CopyMode+         -> RecursiveErrorMode+         -> IO ()+easyCopy from to cm rm = do+  ftype <- getFileType from+  case ftype of+       SymbolicLink -> recreateSymlink from to cm+       RegularFile  -> copyFile from to cm+       Directory    -> copyDirRecursive from to cm rm+       _            -> return ()++++++    ---------------------+    --[ File Deletion ]--+    ---------------------+++-- |Deletes the given file. Raises `eISDIR`+-- if run on a directory. Does not follow symbolic links.+--+-- Throws:+--+--    - `InappropriateType` for wrong file type (directory)+--    - `NoSuchThing` if the file does not exist+--    - `PermissionDenied` if the directory cannot be read+deleteFile :: Path b -> IO ()+deleteFile (MkPath p) = removeLink p+++-- |Deletes the given directory, which must be empty, never symlinks.+--+-- Throws:+--+--    - `InappropriateType` for wrong file type (symlink to directory)+--    - `InappropriateType` for wrong file type (regular file)+--    - `NoSuchThing` if directory does not exist+--    - `UnsatisfiedConstraints` if directory is not empty+--    - `PermissionDenied` if we can't open or write to parent directory+--+-- Notes: calls `rmdir`+deleteDir :: Path b -> IO ()+deleteDir (MkPath p) = removeDirectory p+++-- |Deletes the given directory recursively. Does not follow symbolic+-- links. Tries `deleteDir` first before attemtping a recursive+-- deletion.+--+-- On directory contents this behaves like `easyDelete`+-- and thus will ignore any file type that is not `RegularFile`,+-- `SymbolicLink` or `Directory`.+--+-- Safety/reliability concerns:+--+--    * not atomic+--    * examines filetypes explicitly+--+-- Throws:+--+--    - `InappropriateType` for wrong file type (symlink to directory)+--    - `InappropriateType` for wrong file type (regular file)+--    - `NoSuchThing` if directory does not exist+--    - `PermissionDenied` if we can't open or write to parent directory+deleteDirRecursive :: Path b -> IO ()+deleteDirRecursive 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+          _            -> return ()+      removeDirectory . toFilePath $ p+++-- |Deletes a file, directory or symlink.+-- In case of directory, performs recursive deletion. In case of+-- a symlink, the symlink file is deleted.+-- Any other file type is ignored.+--+-- Safety/reliability concerns:+--+--    * examines filetypes explicitly+--    * calls `deleteDirRecursive` for directories+easyDelete :: Path b -> IO ()+easyDelete p = do+  ftype <- getFileType p+  case ftype of+    SymbolicLink -> deleteFile p+    Directory    -> deleteDirRecursive p+    RegularFile  -> deleteFile p+    _            -> return ()+++++    --------------------+    --[ File Opening ]--+    --------------------+++-- |Opens a file appropriately by invoking xdg-open. The file type+-- is not checked. This forks a process.+openFile :: Path b+         -> IO ProcessID+openFile (MkPath fp) =+  SPP.forkProcess $ SPP.executeFile "xdg-open" True [fp] Nothing+++-- |Executes a program with the given arguments. This forks a process.+executeFile :: Path b          -- ^ program+            -> [ByteString]    -- ^ arguments+            -> IO ProcessID+executeFile (MkPath fp) args =+  SPP.forkProcess $ SPP.executeFile fp 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 already exists+--    - `NoSuchThing` if any of the parent components of the path+--      do not exist+createRegularFile :: FileMode -> Path b -> IO ()+createRegularFile fm (MkPath destBS) =+  bracket (SPI.openFd destBS SPI.WriteOnly (Just fm)+                      (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 already exists+--    - `NoSuchThing` if any of the parent components of the path+--      do not exist+createDir :: FileMode -> Path b -> IO ()+createDir fm (MkPath destBS) = createDirectory destBS fm+++-- |Create an empty directory at the given directory with the given filename.+-- All parent directories are created with the same filemode. This+-- basically behaves like:+--+-- @+--   mkdir -p \/some\/dir+-- @+--+-- Safety/reliability concerns:+--+--    * not atomic+--+-- Throws:+--+--    - `PermissionDenied` if any part of the path components do not+--      exist and cannot be written to+--    - `AlreadyExists` if destination already exists and+--      is not a directory+--+-- Note: calls `getcwd` if the input path is a relative path+createDirRecursive :: FileMode -> Path b -> IO ()+createDirRecursive fm p =+  toAbs p >>= go+  where+    go :: Path Abs -> IO ()+    go dest@(MkPath destBS) = do+      catchIOError (createDirectory destBS fm) $ \e -> do+        errno <- getErrno+        case errno of+             en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e)+                | en == eNOENT -> createDirRecursive fm (dirname dest)+                                  >> createDirectory destBS fm+                | otherwise    -> ioError e+++-- |Create a symlink.+--+-- Throws:+--+--    - `PermissionDenied` if output directory cannot be written to+--    - `AlreadyExists` if destination file already exists+--    - `NoSuchThing` if any of the parent components of the path+--      do not exist+--+-- Note: calls `symlink`+createSymlink :: Path b     -- ^ destination file+              -> ByteString -- ^ path the symlink points to+              -> IO ()+createSymlink (MkPath destBS) sympoint+  = createSymbolicLink sympoint destBS++++    ----------------------------+    --[ File Renaming/Moving ]--+    ----------------------------+++-- |Rename a given file with the provided filename. Destination and source+-- must be on the same device, otherwise `eXDEV` will be raised.+--+-- Does not follow symbolic links, but renames the symbolic link file.+--+-- Safety/reliability concerns:+--+--    * has a separate set of exception handling, apart from the syscall+--+-- Throws:+--+--     - `NoSuchThing` if source file does not exist+--     - `PermissionDenied` if output directory cannot be written to+--     - `PermissionDenied` if source directory cannot be opened+--     - `UnsupportedOperation` if source and destination are on different+--       devices+--     - `AlreadyExists` if destination already exists+--     - `SameFile` if destination and source are the same file+--       (`HPathIOException`)+--+-- Note: calls `rename` (but does not allow to rename over existing files)+renameFile :: Path b1 -> Path b2 -> IO ()+renameFile fromf@(MkPath fromfBS) tof@(MkPath tofBS) = do+  throwSameFile fromf tof+  throwFileDoesExist tof+  throwDirDoesExist tof+  rename fromfBS tofBS+++-- |Move a file. This also works across devices by copy-delete fallback.+-- And also works on directories.+--+-- Does not follow symbolic links, but renames the symbolic link file.+--+--+-- Safety/reliability concerns:+--+--    * `Overwrite` mode is not atomic+--    * copy-delete fallback is inherently non-atomic+--    * since this function calls `easyCopy` and `easyDelete` as a fallback+--      to `renameFile`, file types that are not `RegularFile`, `SymbolicLink`+--      or `Directory` may be ignored+--    * for `Overwrite` mode, the destination will be deleted (not recursively)+--      before moving+--+-- Throws:+--+--     - `NoSuchThing` if source file does not exist+--     - `PermissionDenied` if output directory cannot be written to+--     - `PermissionDenied` if source directory cannot be opened+--     - `SameFile` if destination and source are the same file+--       (`HPathIOException`)+--+-- Throws in `Strict` mode only:+--+--    - `AlreadyExists` if destination already exists+--+-- Notes:+--+--    - calls `rename` (but does not allow to rename over existing files)+--    - calls `getcwd` in Overwrite mode if destination is a relative path+moveFile :: Path b1   -- ^ file to move+         -> Path b2   -- ^ destination+         -> CopyMode+         -> IO ()+moveFile from to cm = do+  throwSameFile from to+  case cm of+    Strict -> catchErrno [eXDEV] (renameFile from to) $ do+                easyCopy from to Strict FailEarly+                easyDelete from+    Overwrite -> do+      ft <- getFileType from+      writable <- toAbs to >>= isWritable+      case ft of+        RegularFile -> do+          exists <- doesFileExist to+          when (exists && writable) (deleteFile to)+        SymbolicLink -> do+          exists <- doesFileExist to+          when (exists && writable) (deleteFile to)+        Directory -> do+          exists <- doesDirectoryExist to+          when (exists && writable) (deleteDir to)+        _ -> return ()+      moveFile from to Strict++++++    --------------------+    --[ File Reading ]--+    --------------------+++-- |Read the given file at once into memory as a strict ByteString.+-- Symbolic links are followed, no sanity checks on file size+-- or file type. File must exist.+--+-- Note: the size of the file is determined in advance, as to only+-- have one allocation.+--+-- Safety/reliability concerns:+--+--    * since amount of bytes to read is determined in advance,+--      the file might be read partially only if something else is+--      appending to it while reading+--    * the whole file is read into memory!+--+-- Throws:+--+--     - `InappropriateType` if file is not a regular file or a symlink+--     - `PermissionDenied` if we cannot read the file or the directory+--        containting it+--     - `NoSuchThing` if the file does not exist+readFile :: Path b -> IO ByteString+readFile (MkPath fp) =+  bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> do+    stat <- PF.getFdStatus fd+    let fsize = PF.fileSize stat+    SPB.fdRead fd (fromIntegral fsize)+++-- |Read the given file in chunks of size `8192` into memory until+-- `fread` returns 0. Returns a lazy ByteString, because it uses+-- Builders under the hood.+--+-- Safety/reliability concerns:+--+--    * the whole file is read into memory!+--+-- Throws:+--+--     - `InappropriateType` if file is not a regular file or a symlink+--     - `PermissionDenied` if we cannot read the file or the directory+--        containting it+--     - `NoSuchThing` if the file does not exist+readFileEOF :: Path b -> IO L.ByteString+readFileEOF (MkPath fp) =+  bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd ->+    allocaBytes (fromIntegral bufSize) $ \buf -> read' fd buf mempty+  where+    bufSize :: CSize+    bufSize = 8192+    read' :: Fd -> Ptr Word8 -> Builder -> IO L.ByteString+    read' fd buf builder = do+        size <- SPB.fdReadBuf fd buf bufSize+        if size == 0+          then return $ toLazyByteString builder+          else do+            readBS <- unsafePackCStringFinalizer buf+                                                 (fromIntegral size)+                                                 (return ())+            read' fd buf (builder <> byteString readBS)+++++    --------------------+    --[ File Writing ]--+    --------------------+++-- |Write a given ByteString to a file, truncating the file beforehand.+-- The file must exist. Follows symlinks.+--+-- Throws:+--+--     - `InappropriateType` if file is not a regular file or a symlink+--     - `PermissionDenied` if we cannot read the file or the directory+--        containting it+--     - `NoSuchThing` if the file does not exist+writeFile :: Path b -> ByteString -> IO ()+writeFile (MkPath fp) bs =+  bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] Nothing) (SPI.closeFd) $ \fd -> +    void $ SPB.fdWrite fd bs+++-- |Append a given ByteString to a file.+-- The file must exist. Follows symlinks.+--+-- Throws:+--+--     - `InappropriateType` if file is not a regular file or a symlink+--     - `PermissionDenied` if we cannot read the file or the directory+--        containting it+--     - `NoSuchThing` if the file does not exist+appendFile :: Path b -> ByteString -> IO ()+appendFile (MkPath fp) bs =+  bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing)+          (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs+++++    -----------------------+    --[ 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.+--+-- The contents are not sorted and there is no guarantee on the ordering.+--+-- Throws:+--+--     - `NoSuchThing` if directory does not exist+--     - `InappropriateType` if file type is wrong (file)+--     - `InappropriateType` if file type is wrong (symlink to file)+--     - `InappropriateType` if file type is wrong (symlink to dir)+--     - `PermissionDenied` if directory cannot be opened+getDirsFiles :: Path b        -- ^ dir to read+             -> IO [Path b]+getDirsFiles p@(MkPath fp) = do+  fd <- openFd fp SPI.ReadOnly [SPDF.oNofollow] Nothing+  return+    . catMaybes+    .   fmap (\x -> (</>) p <$> (parseMaybe . snd $ x))+    =<< getDirectoryContents' fd+  where+    parseMaybe :: ByteString -> Maybe (Path Fn)+    parseMaybe = parseFn+++++    ---------------------------+    --[ FileType operations ]--+    ---------------------------+++-- |Get the file type of the file located at the given path. Does+-- not follow symbolic links.+--+-- Throws:+--+--    - `NoSuchThing` if the file does not exist+--    - `PermissionDenied` if any part of the path is not accessible+getFileType :: Path b -> IO FileType+getFileType (MkPath fp) = do+  fs <- PF.getSymbolicLinkStatus fp+  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 path.+--+-- Throws:+--+--    - `NoSuchThing` if the file at the given path does not exist+--    - `NoSuchThing` if the symlink is broken+canonicalizePath :: Path b -> IO (Path Abs)+canonicalizePath (MkPath l) = do+  nl <- SPDT.realpath l+  return $ MkPath nl+++-- |Converts any path to an absolute path.+-- This is done in the following way:+--+--    - if the path is already an absolute one, just return it+--    - if it's a relative path, prepend the current directory to it+toAbs :: Path b -> IO (Path Abs)+toAbs (MkPath bs) = do+  let mabs = parseAbs bs :: Maybe (Path Abs)+  case mabs of+    Just a -> return a+    Nothing  -> do+      cwd <- getWorkingDirectory >>= parseAbs+      rel <- parseRel bs -- we know it must be relative now+      return $ cwd </> rel
+ src/HPath/IO.hs-boot view
@@ -0,0 +1,8 @@+module HPath.IO where+++import HPath++canonicalizePath :: Path b -> IO (Path Abs)++toAbs :: Path b -> IO (Path Abs)
+ src/HPath/IO/Errors.hs view
@@ -0,0 +1,360 @@+-- |+-- Module      :  HPath.IO.Errors+-- Copyright   :  © 2016 Julian Ospald+-- License     :  BSD3+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- Provides error handling.++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HPath.IO.Errors+  (+  -- * Types+    HPathIOException(..)+  , RecursiveFailureHint(..)++  -- * Exception identifiers+  , isSameFile+  , isDestinationInSource+  , isRecursiveFailure+  , isReadContentsFailed+  , isCreateDirFailed+  , isCopyFileFailed+  , isRecreateSymlinkFailed++  -- * Path based functions+  , throwFileDoesExist+  , throwDirDoesExist+  , throwSameFile+  , sameFile+  , throwDestinationInSource+  , doesFileExist+  , doesDirectoryExist+  , isWritable+  , canOpenDirectory++  -- * Error handling functions+  , catchErrno+  , rethrowErrnoAs+  , handleIOError+  , bracketeer+  , reactOnError+  )+  where+++import Control.Applicative+  (+    (<$>)+  )+import Control.Exception+import Control.Monad+  (+    forM+  , when+  )+import Control.Monad.IfElse+  (+    whenM+  )+import Data.ByteString+  (+    ByteString+  )+import Data.ByteString.UTF8+  (+    toString+  )+import Data.Typeable+  (+    Typeable+  )+import Foreign.C.Error+  (+    getErrno+  , Errno+  )+import GHC.IO.Exception+  (+    IOErrorType+  )+import HPath+import HPath.Internal+  (+    Path(..)+  )+import {-# SOURCE #-} HPath.IO+  (+    canonicalizePath+  , toAbs+  )+import System.IO.Error+  (+    alreadyExistsErrorType+  , catchIOError+  , ioeGetErrorType+  , mkIOError+  )++import qualified System.Posix.Directory.ByteString as PFD+import System.Posix.Files.ByteString+  (+    fileAccess+  , getFileStatus+  )+import qualified System.Posix.Files.ByteString as PF+++-- |Additional generic IO exceptions that the posix functions+-- do not provide.+data HPathIOException = SameFile ByteString ByteString+                      | DestinationInSource ByteString ByteString+                      | RecursiveFailure [(RecursiveFailureHint, IOException)]+  deriving (Eq, Show, Typeable)+++-- |A type for giving failure hints on recursive failure, which allows+-- to programmatically make choices without examining+-- the weakly typed I/O error attributes (like `ioeGetFileName`).+--+-- The first argument to the data constructor is always the+-- source and the second the destination.+data RecursiveFailureHint = ReadContentsFailed    ByteString ByteString+                          | CreateDirFailed       ByteString ByteString+                          | CopyFileFailed        ByteString ByteString+                          | RecreateSymlinkFailed ByteString ByteString+  deriving (Eq, Show)+++instance Exception HPathIOException+++toConstr :: HPathIOException -> String+toConstr SameFile {}            = "SameFile"+toConstr DestinationInSource {} = "DestinationInSource"+toConstr RecursiveFailure {}    = "RecursiveFailure"++++++    -----------------------------+    --[ Exception identifiers ]--+    -----------------------------+++isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool+isSameFile ex = toConstr (ex :: HPathIOException) == toConstr (SameFile mempty mempty)+isDestinationInSource ex = toConstr (ex :: HPathIOException) == (toConstr $ DestinationInSource mempty mempty)+isRecursiveFailure ex = toConstr (ex :: HPathIOException) == (toConstr $ RecursiveFailure mempty)+++isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool+isReadContentsFailed ReadContentsFailed{} = True+isReadContentsFailed _ = False+isCreateDirFailed CreateDirFailed{} = True+isCreateDirFailed _ = False+isCopyFileFailed CopyFileFailed{} = True+isCopyFileFailed _ = False+isRecreateSymlinkFailed RecreateSymlinkFailed{} = True+isRecreateSymlinkFailed _ = False++++++    ----------------------------+    --[ Path based functions ]--+    ----------------------------+++-- |Throws `AlreadyExists` `IOError` if file exists.+throwFileDoesExist :: Path b -> IO ()+throwFileDoesExist fp@(MkPath bs) =+  whenM (doesFileExist fp)+        (ioError . mkIOError+                     alreadyExistsErrorType+                     "File already exists"+                     Nothing+                   $ (Just (toString $ bs))+        )+++-- |Throws `AlreadyExists` `IOError` if directory exists.+throwDirDoesExist :: Path b -> IO ()+throwDirDoesExist fp@(MkPath bs) =+  whenM (doesDirectoryExist fp)+        (ioError . mkIOError+                     alreadyExistsErrorType+                     "Directory already exists"+                     Nothing+                   $ (Just (toString $ bs))+        )+++-- |Uses `isSameFile` and throws `SameFile` if it returns True.+throwSameFile :: Path b1+              -> Path b2+              -> IO ()+throwSameFile fp1@(MkPath bs1) fp2@(MkPath bs2) =+  whenM (sameFile fp1 fp2)+        (throwIO $ SameFile bs1 bs2)+++-- |Check if the files are the same by examining device and file id.+-- This follows symbolic links.+sameFile :: Path b1 -> Path b2 -> IO Bool+sameFile (MkPath fp1) (MkPath fp2) =+  handleIOError (\_ -> return False) $ do+    fs1 <- getFileStatus fp1+    fs2 <- getFileStatus fp2++    if ((PF.deviceID fs1, PF.fileID fs1) ==+        (PF.deviceID fs2, PF.fileID fs2))+      then return True+      else return False+++-- TODO: make this more robust when destination does not exist+-- |Checks whether the destination directory is contained+-- within the source directory by comparing the device+file ID of the+-- source directory with all device+file IDs of the parent directories+-- of the destination.+throwDestinationInSource :: Path b1 -- ^ source dir+                         -> Path b2 -- ^ full destination, @dirname dest@+                                    --   must exist+                         -> IO ()+throwDestinationInSource (MkPath sbs) dest@(MkPath dbs) = do+  destAbs <- toAbs dest+  dest'   <- (\x -> maybe x (\y -> x </> y) $ basename dest)+             <$> (canonicalizePath $ dirname destAbs)+  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 sbs+  when (elem sid dids)+       (throwIO $ DestinationInSource dbs sbs)+++-- |Checks if the given file exists and is not a directory.+-- Does not follow symlinks.+doesFileExist :: Path b -> IO Bool+doesFileExist (MkPath bs) =+  handleIOError (\_ -> return False) $ do+    fs  <- PF.getSymbolicLinkStatus bs+    return $ not . PF.isDirectory $ fs+++-- |Checks if the given file exists and is a directory.+-- Does not follow symlinks.+doesDirectoryExist :: Path b -> IO Bool+doesDirectoryExist (MkPath bs) =+  handleIOError (\_ -> return False) $ do+    fs  <- PF.getSymbolicLinkStatus bs+    return $ PF.isDirectory fs+++-- |Checks whether a file or folder is writable.+isWritable :: Path b -> IO Bool+isWritable (MkPath bs) =+  handleIOError (\_ -> return False) $+    fileAccess bs False True False+++-- |Checks whether the directory at the given path exists and can be+-- opened. This invokes `openDirStream` which follows symlinks.+canOpenDirectory :: Path b -> IO Bool+canOpenDirectory (MkPath bs) =+  handleIOError (\_ -> return False) $ do+    bracket (PFD.openDirStream bs)+            PFD.closeDirStream+            (\_ -> return ())+    return True+++++    --------------------------------+    --[ 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 HPathIOException+             -> IO a+reactOnError a ios fmios =+  a `catches` [iohandler, fmiohandler]+  where+    iohandler = Handler $+      \(ex :: IOException) ->+         foldr (\(t, a') y -> if ioeGetErrorType ex == t+                                then a'+                                else y)+               (throwIO ex)+               ios+    fmiohandler = Handler $+      \(ex :: HPathIOException) ->+         foldr (\(t, a') y -> if toConstr ex == toConstr t+                                then a'+                                else y)+               (throwIO ex)+               fmios+
+ 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,264 @@+-- |+-- Module      :  System.Posix.Directory.Traversals+-- Copyright   :  © 2016 Julian Ospald+-- License     :  BSD3+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- Traversal and read operations on directories.+++{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -Wall #-}+++module System.Posix.Directory.Traversals (++  getDirectoryContents+, getDirectoryContents'++, allDirectoryContents+, allDirectoryContents'+, traverseDirectory++-- lower-level stuff+, readDirEnt+, packDirStream+, unpackDirStream+, fdOpendir++, realpath+) where+++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif+import Control.Monad+import System.Posix.FilePath ((</>))+import System.Posix.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 "unix" System.Posix.IO.ByteString (closeFd)+import Unsafe.Coerce (unsafeCoerce)+import Foreign.C.Error+import Foreign.C.String+import Foreign.C.Types+import Foreign.Marshal.Alloc (alloca,allocaBytes)+import Foreign.Ptr+import Foreign.Storable+++++----------------------------------------------------------++-- | Get all files from a directory and its subdirectories.+--+-- Upon entering a directory, 'allDirectoryContents' will get all entries+-- strictly.  However the returned list is lazy in that directories will only+-- be accessed on demand.+--+-- Follows symbolic links for the input dir.+allDirectoryContents :: RawFilePath -> IO [RawFilePath]+allDirectoryContents topdir = do+    namesAndTypes <- getDirectoryContents topdir+    let properNames = filter ((`notElem` [".", ".."]) . snd) namesAndTypes+    paths <- forM properNames $ \(typ,name) -> unsafeInterleaveIO $ do+        let path = topdir </> name+        case () of+            () | typ == dtDir -> allDirectoryContents path+               | typ == dtUnknown -> do+                    isDir <- isDirectory <$> getFileStatus path+                    if isDir+                        then allDirectoryContents path+                        else return [path]+               | otherwise -> return [path]+    return (topdir : concat paths)++-- | Get all files from a directory and its subdirectories strictly.+--+-- Follows symbolic links for the input dir.+allDirectoryContents' :: RawFilePath -> IO [RawFilePath]+allDirectoryContents' = fmap reverse . traverseDirectory (\acc fp -> return (fp:acc)) []+-- this uses traverseDirectory because it's more efficient than forcing the+-- lazy version.++-- | Recursively apply the 'action' to the parent directory and all+-- files/subdirectories.+--+-- This function allows for memory-efficient traversals.+--+-- Follows symbolic links for the input dir.+traverseDirectory :: (s -> RawFilePath -> IO s) -> s -> RawFilePath -> IO s+traverseDirectory act s0 topdir = toploop+  where+    toploop = do+        isDir <- isDirectory <$> getFileStatus topdir+        s' <- act s0 topdir+        if isDir then actOnDirContents topdir s' loop+                 else return s'+    loop typ path acc = do+        isDir <- case () of+            () | typ == dtDir     -> return True+               | typ == dtUnknown -> isDirectory <$> getFileStatus path+               | otherwise        -> return False+        if isDir+          then act acc path >>= \acc' -> actOnDirContents path acc' loop+          else act acc path++actOnDirContents :: RawFilePath+                 -> b+                 -> (DirType -> RawFilePath -> b -> IO b)+                 -> IO b+actOnDirContents pathRelToTop b f =+  modifyIOError ((`ioeSetFileName` (BS.unpack pathRelToTop)) .+                 (`ioeSetLocation` "findBSTypRel")) $+    bracket+      (openDirStream pathRelToTop)+      Posix.closeDirStream+      (\dirp -> loop dirp b)+ where+  loop dirp b' = do+    (typ,e) <- readDirEnt dirp+    if (e == "")+      then return b'+      else+          if (e == "." || e == "..")+              then loop dirp b'+              else f typ (pathRelToTop </> e) b' >>= loop dirp+++----------------------------------------------------------+-- dodgy stuff++type CDir = ()+type CDirent = ()++-- Posix doesn't export DirStream, so to re-use that type we need to use+-- unsafeCoerce.  It's just a newtype, so this is a legitimate usage.+-- ugly trick.+unpackDirStream :: DirStream -> Ptr CDir+unpackDirStream = unsafeCoerce++packDirStream :: Ptr CDir -> DirStream+packDirStream = unsafeCoerce++-- the __hscore_* functions are defined in the unix package.  We can import them and let+-- the linker figure it out.+foreign import ccall unsafe "__hscore_readdir"+  c_readdir  :: Ptr CDir -> Ptr (Ptr CDirent) -> IO CInt++foreign import ccall unsafe "__hscore_free_dirent"+  c_freeDirEnt  :: Ptr CDirent -> IO ()++foreign import ccall unsafe "__hscore_d_name"+  c_name :: Ptr CDirent -> IO CString++foreign import ccall unsafe "__posixdir_d_type"+  c_type :: Ptr CDirent -> IO DirType++foreign import ccall "realpath"+  c_realpath :: CString -> CString -> IO CString++foreign import ccall unsafe "fdopendir"+  c_fdopendir :: Posix.Fd -> IO (Ptr ())++----------------------------------------------------------+-- less dodgy but still lower-level+++readDirEnt :: DirStream -> IO (DirType, RawFilePath)+readDirEnt (unpackDirStream -> dirp) =+  alloca $ \ptr_dEnt  -> loop ptr_dEnt+ where+  loop ptr_dEnt = do+    resetErrno+    r <- c_readdir dirp ptr_dEnt+    if (r == 0)+       then do+         dEnt <- peek ptr_dEnt+         if (dEnt == nullPtr)+            then return (dtUnknown,BS.empty)+            else do+                 dName <- c_name dEnt >>= peekFilePath+                 dType <- c_type dEnt+                 c_freeDirEnt dEnt+                 return (dType, dName)+       else do+         errno <- getErrno+         if (errno == eINTR)+            then loop ptr_dEnt+            else do+                 let (Errno eo) = errno+                 if (eo == 0)+                    then return (dtUnknown,BS.empty)+                    else throwErrno "readDirEnt"+++-- |Gets all directory contents (not recursively).+getDirectoryContents :: RawFilePath -> IO [(DirType, RawFilePath)]+getDirectoryContents path =+  modifyIOError ((`ioeSetFileName` (BS.unpack path)) .+                 (`ioeSetLocation` "System.Posix.Directory.Traversals.getDirectoryContents")) $+    bracket+      (PosixBS.openDirStream path)+      PosixBS.closeDirStream+      _dirloop+++-- |Binding to @fdopendir(3)@.+fdOpendir :: Posix.Fd -> IO DirStream+fdOpendir fd =+    packDirStream <$> throwErrnoIfNull "fdOpendir" (c_fdopendir fd)+++-- |Like `getDirectoryContents` except for a file descriptor.+--+-- To avoid complicated error checks, the file descriptor is+-- __always__ closed, even if `fdOpendir` fails. Usually, this+-- only happens on successful `fdOpendir` and after the directory+-- stream is closed. Also see the manpage of @fdopendir(3)@ for+-- more details.+getDirectoryContents' :: Posix.Fd -> IO [(DirType, RawFilePath)]+getDirectoryContents' fd = do+  dirstream <- fdOpendir fd `catchIOError` \e -> do+    closeFd fd+    ioError e+  -- closeDirStream closes the filedescriptor+  finally (_dirloop dirstream) (PosixBS.closeDirStream dirstream)+++_dirloop :: DirStream -> IO [(DirType, RawFilePath)]+{-# INLINE _dirloop #-}+_dirloop dirp = do+   t@(_typ,e) <- readDirEnt dirp+   if BS.null e then return [] else do+     es <- _dirloop dirp+     return (t:es)+++-- | return the canonicalized absolute pathname+--+-- like canonicalizePath, but uses @realpath(3)@+realpath :: RawFilePath -> IO RawFilePath+realpath inp =+    allocaBytes pathMax $ \tmp -> do+        void $ BS.useAsCString inp $ \cstr -> throwErrnoIfNull "realpath" $ c_realpath cstr tmp+        BS.packCString tmp
+ src/System/Posix/FD.hs view
@@ -0,0 +1,75 @@+-- |+-- Module      :  System.Posix.FD+-- Copyright   :  © 2016 Julian Ospald+-- License     :  BSD3+--+-- Maintainer  :  Julian Ospald <hasufell@posteo.de>+-- Stability   :  experimental+-- Portability :  portable+--+-- Provides an alternative for `System.Posix.IO.ByteString.openFd`+-- which gives us more control on what status flags to pass to the+-- low-level @open(2)@ call, in contrast to the unix package.+++{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++{-# OPTIONS_GHC -Wall #-}+++module System.Posix.FD (+    openFd+) where+++import Foreign.C.String+import Foreign.C.Types+import System.Posix.Directory.Foreign+import qualified System.Posix as Posix+import System.Posix.ByteString.FilePath+++foreign import ccall unsafe "open"+   c_open :: CString -> CInt -> Posix.CMode -> IO CInt+++open_  :: CString+       -> Posix.OpenMode+       -> [Flags]+       -> Maybe Posix.FileMode+       -> IO Posix.Fd+open_ str how optional_flags maybe_mode = do+    fd <- c_open str all_flags mode_w+    return (Posix.Fd fd)+  where+    all_flags  = unionFlags $ optional_flags ++ [open_mode] ++ creat+++    (creat, mode_w) = case maybe_mode of+                        Nothing -> ([],0)+                        Just x  -> ([oCreat], x)++    open_mode = case how of+                   Posix.ReadOnly  -> oRdonly+                   Posix.WriteOnly -> oWronly+                   Posix.ReadWrite -> oRdwr+++-- |Open and optionally create this file. See 'System.Posix.Files'+-- for information on how to use the 'FileMode' type.+--+-- Note that passing @Just x@ as the 4th argument triggers the+-- `oCreat` status flag, which must be set when you pass in `oExcl`+-- to the status flags. Also see the manpage for @open(2)@.+openFd :: RawFilePath+       -> Posix.OpenMode+       -> [Flags]               -- ^ status flags of @open(2)@+       -> Maybe Posix.FileMode  -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist.+       -> IO Posix.Fd+openFd name how optional_flags maybe_mode =+   withFilePath name $ \str ->+     throwErrnoPathIfMinus1Retry "openFd" name $+       open_ str how optional_flags maybe_mode+
+ test/HPath/IO/AppendFileSpec.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.AppendFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "AppendFileSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "fileWithContent"+  createRegularFile' "fileWithoutContent"+  createSymlink' "inputFileSymL" "fileWithContent"+  createDir' "alreadyExistsD"+  createRegularFile' "noPerms"+  noPerms "noPerms"+  createDir' "noPermsD"+  createRegularFile' "noPermsD/inputFile"+  noPerms "noPermsD"+  writeFile' "fileWithContent" "BLKASL"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "fileWithContent"+  deleteFile' "fileWithoutContent"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  normalFilePerms "noPerms"+  deleteFile' "noPerms"+  normalDirPerms "noPermsD"+  deleteFile' "noPermsD/inputFile"+  deleteDir' "noPermsD"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.appendFile" $ do++    -- successes --+    it "appendFile file with content, everything clear" $ do+      appendFile' "fileWithContent" "blahfaselllll"+      out <- readFile' "fileWithContent"+      out `shouldBe` "BLKASLblahfaselllll"++    it "appendFile file with content, everything clear" $ do+      appendFile' "fileWithContent" "gagagaga"+      out <- readFile' "fileWithContent"+      out `shouldBe` "BLKASLblahfaselllllgagagaga"++    it "appendFile file with content, everything clear" $ do+      appendFile' "fileWithContent" ""+      out <- readFile' "fileWithContent"+      out `shouldBe` "BLKASLblahfaselllllgagagaga"++    it "appendFile file without content, everything clear" $ do+      appendFile' "fileWithoutContent" "blahfaselllll"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "blahfaselllll"++    it "appendFile, everything clear" $ do+      appendFile' "fileWithoutContent" "gagagaga"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "blahfaselllllgagagaga"++    it "appendFile symlink, everything clear" $ do+      appendFile' "inputFileSymL" "blahfaselllll"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllll"++    it "appendFile symlink, everything clear" $ do+      appendFile' "inputFileSymL" "gagagaga"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "BLKASLblahfaselllllgagagagablahfaselllllgagagaga"+++    -- posix failures --+    it "appendFile to dir, inappropriate type" $ do+      appendFile' "alreadyExistsD" ""+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "appendFile, no permissions to file" $ do+      appendFile' "noPerms" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "appendFile, no permissions to file" $ do+      appendFile' "noPermsD/inputFile" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "appendFile, file does not exist" $ do+      appendFile' "gaga" ""+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)
+ test/HPath/IO/CanonicalizePathSpec.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CanonicalizePathSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CanonicalizePathSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "file"+  createDir' "dir"+  createSymlink' "dirSym" "dir/"+  createSymlink' "brokenSym" "nothing"+  createSymlink' "fileSym" "file"++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "file"+  deleteDir' "dir"+  deleteFile' "dirSym"+  deleteFile' "brokenSym"+  deleteFile' "fileSym"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.canonicalizePath" $ do++    -- successes --+    it "canonicalizePath, all fine" $ do+      path <- withTmpDir "file" return+      canonicalizePath' "file"+        `shouldReturn` path++    it "canonicalizePath, all fine" $ do+      path <- withTmpDir "dir" return+      canonicalizePath' "dir"+        `shouldReturn` path++    it "canonicalizePath, all fine" $ do+      path <- withTmpDir "file" return+      canonicalizePath' "fileSym"+        `shouldReturn` path++    it "canonicalizePath, all fine" $ do+      path <- withTmpDir "dir" return+      canonicalizePath' "dirSym"+        `shouldReturn` path+++    -- posix failures --+    it "canonicalizePath, broken symlink" $+      canonicalizePath' "brokenSym"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "canonicalizePath, file does not exist" $+      canonicalizePath' "nothingBlah"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)+
+ test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.CopyDirRecursiveCollectFailuresSpec where+++import Test.Hspec+import Data.List (sort)+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Exit+import System.Process+import Utils+import qualified Data.ByteString as BS+import Data.ByteString.UTF8 (toString)++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CopyDirRecursiveCollectFailuresSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "alreadyExists"+  createRegularFile' "wrongInput"+  createSymlink' "wrongInputSymL" "inputDir/"+  createDir' "alreadyExistsD"+  createDir' "noPerms"+  createDir' "noWritePerm"++  createDir' "inputDir"+  createDir' "inputDir/bar"+  createDir' "inputDir/foo"+  createRegularFile' "inputDir/foo/inputFile1"+  createRegularFile' "inputDir/inputFile2"+  createRegularFile' "inputDir/bar/inputFile3"+  writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"+  writeFile' "inputDir/inputFile2" "Blahfaselgagaga"+  writeFile' "inputDir/bar/inputFile3"+    "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"++  createDir' "inputDir1"+  createDir' "inputDir1/foo2"+  createDir' "inputDir1/foo2/foo3"+  createDir' "inputDir1/foo2/foo4"+  createRegularFile' "inputDir1/foo2/inputFile1"+  createRegularFile' "inputDir1/foo2/inputFile2"+  createRegularFile' "inputDir1/foo2/inputFile3"+  createRegularFile' "inputDir1/foo2/foo4/inputFile4"+  createRegularFile' "inputDir1/foo2/foo4/inputFile6"+  createRegularFile' "inputDir1/foo2/foo3/inputFile5"+  noPerms "inputDir1/foo2/foo3"++  createDir' "outputDir1"+  createDir' "outputDir1/foo2"+  createDir' "outputDir1/foo2/foo4"+  createDir' "outputDir1/foo2/foo4/inputFile4"+  createRegularFile' "outputDir1/foo2/foo4/inputFile6"+  noPerms "outputDir1/foo2/foo4/inputFile4"+  noPerms "outputDir1/foo2/foo4"++  noPerms "noPerms"+  noWritableDirPerms "noWritePerm"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerm"++  normalDirPerms "inputDir1/foo2/foo3"+  deleteFile' "inputDir1/foo2/foo4/inputFile4"+  deleteFile' "inputDir1/foo2/foo4/inputFile6"+  deleteFile' "inputDir1/foo2/inputFile1"+  deleteFile' "inputDir1/foo2/inputFile2"+  deleteFile' "inputDir1/foo2/inputFile3"+  deleteFile' "inputDir1/foo2/foo3/inputFile5"+  deleteDir' "inputDir1/foo2/foo3"+  deleteDir' "inputDir1/foo2/foo4"+  deleteDir' "inputDir1/foo2"+  deleteDir' "inputDir1"++  normalDirPerms "outputDir1/foo2/foo4"+  normalDirPerms "outputDir1/foo2/foo4/inputFile4"+  deleteFile' "outputDir1/foo2/foo4/inputFile6"+  deleteDir' "outputDir1/foo2/foo4/inputFile4"+  deleteDir' "outputDir1/foo2/foo4"+  deleteDir' "outputDir1/foo2"+  deleteDir' "outputDir1"++  deleteFile' "alreadyExists"+  deleteFile' "wrongInput"+  deleteFile' "wrongInputSymL"+  deleteDir' "alreadyExistsD"+  deleteDir' "noPerms"+  deleteDir' "noWritePerm"+  deleteFile' "inputDir/foo/inputFile1"+  deleteFile' "inputDir/inputFile2"+  deleteFile' "inputDir/bar/inputFile3"+  deleteDir' "inputDir/foo"+  deleteDir' "inputDir/bar"+  deleteDir' "inputDir"+++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.copyDirRecursive" $ do++    -- successes --+    it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do+      tmpDir' <- getRawTmpDir+      copyDirRecursive' "inputDir"+                        "outputDir"+                        Strict+                        CollectFailures+      (system $ "diff -r --no-dereference "+                          ++ toString tmpDir' ++ "inputDir" ++ " "+                          ++ toString tmpDir' ++ "outputDir"+                          ++ " >/dev/null")+        `shouldReturn` ExitSuccess+      removeDirIfExists "outputDir"++    -- posix failures --+    it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $+      copyDirRecursive' "doesNotExist"+                        "outputDir"+                        Strict+                        CollectFailures+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $+      copyDirRecursive' "noPerms/inputDir"+                        "foo"+                        Strict+                        CollectFailures+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+++    -- custom failures+    it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do+      copyDirRecursive' "inputDir1/foo2"+                        "outputDir1/foo2"+                        Overwrite+                        CollectFailures+        `shouldThrow`+        (\(RecursiveFailure ex@[_, _]) ->+          any (\(h, e) -> ioeGetErrorType e == InappropriateType+                          && isCopyFileFailed h) ex &&+          any (\(h, e) -> ioeGetErrorType e == PermissionDenied+                          && isReadContentsFailed h) ex)+      normalDirPerms "outputDir1/foo2/foo4"+      normalDirPerms "outputDir1/foo2/foo4/inputFile4"+      c <- allDirectoryContents' "outputDir1"+      tmpDir' <- getRawTmpDir+      let shouldC = (fmap (\x -> tmpDir' `BS.append` x)+                          ["outputDir1"+                          ,"outputDir1/foo2"+                          ,"outputDir1/foo2/inputFile1"+                          ,"outputDir1/foo2/inputFile2"+                          ,"outputDir1/foo2/inputFile3"+                          ,"outputDir1/foo2/foo4"+                          ,"outputDir1/foo2/foo4/inputFile6"+                          ,"outputDir1/foo2/foo4/inputFile4"])+      deleteFile' "outputDir1/foo2/inputFile1"+      deleteFile' "outputDir1/foo2/inputFile2"+      deleteFile' "outputDir1/foo2/inputFile3"+      sort c `shouldBe` sort shouldC+++    it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $+      copyDirRecursive' "inputDir"+                        "noWritePerm/foo"+                        Strict+                        CollectFailures+        `shouldThrow`+        (\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $+      copyDirRecursive' "inputDir"+                        "noPerms/foo"+                        Strict+                        CollectFailures+        `shouldThrow`+        isRecursiveFailure++    it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $+      copyDirRecursive' "inputDir"+                        "alreadyExistsD"+                        Strict+                        CollectFailures+        `shouldThrow`+        (\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists)++    it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $+      copyDirRecursive' "inputDir"+                        "alreadyExists"+                        Strict+                        CollectFailures+        `shouldThrow`+        isRecursiveFailure++    it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $+      copyDirRecursive' "wrongInput"+                        "outputDir"+                        Strict+                        CollectFailures+        `shouldThrow`+        (\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType)++    it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $+      copyDirRecursive' "wrongInputSymL"+                        "outputDir"+                        Strict+                        CollectFailures+        `shouldThrow`+        (\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument)++    it "copyDirRecursive (Strict, CollectFailures), destination in source" $+      copyDirRecursive' "inputDir"+                        "inputDir/foo"+                        Strict+                        CollectFailures+        `shouldThrow`+        isDestinationInSource++    it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $+      copyDirRecursive' "inputDir"+                        "inputDir"+                        Strict+                        CollectFailures+        `shouldThrow`+        isSameFile++
+ test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs view
@@ -0,0 +1,205 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.CopyDirRecursiveOverwriteSpec where+++import Test.Hspec+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Exit+import System.Process+import Utils+import Data.ByteString.UTF8 (toString)++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CopyDirRecursiveOverwriteSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "alreadyExists"+  createRegularFile' "wrongInput"+  createSymlink' "wrongInputSymL" "inputDir/"+  createDir' "noPerms"+  createDir' "noWritePerm"++  createDir' "inputDir"+  createDir' "inputDir/bar"+  createDir' "inputDir/foo"+  createRegularFile' "inputDir/foo/inputFile1"+  createRegularFile' "inputDir/inputFile2"+  createRegularFile' "inputDir/bar/inputFile3"+  writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"+  writeFile' "inputDir/inputFile2" "Blahfaselgagaga"+  writeFile' "inputDir/bar/inputFile3"+    "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"++  createDir' "alreadyExistsD"+  createDir' "alreadyExistsD/bar"+  createDir' "alreadyExistsD/foo"+  createRegularFile' "alreadyExistsD/foo/inputFile1"+  createRegularFile' "alreadyExistsD/inputFile2"+  createRegularFile' "alreadyExistsD/bar/inputFile3"+  writeFile' "alreadyExistsD/foo/inputFile1" "DAAsada"+  writeFile' "alreadyExistsD/inputFile2" "ahfaagaga"+  writeFile' "alreadyExistsD/bar/inputFile3"+    "f3223sasdasdaasdasdasasd4"++  noPerms "noPerms"+  noWritableDirPerms "noWritePerm"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerm"+  deleteFile' "alreadyExists"+  deleteFile' "wrongInput"+  deleteFile' "wrongInputSymL"+  deleteDir' "noPerms"+  deleteDir' "noWritePerm"+  deleteFile' "inputDir/foo/inputFile1"+  deleteFile' "inputDir/inputFile2"+  deleteFile' "inputDir/bar/inputFile3"+  deleteDir' "inputDir/foo"+  deleteDir' "inputDir/bar"+  deleteDir' "inputDir"+  deleteFile' "alreadyExistsD/foo/inputFile1"+  deleteFile' "alreadyExistsD/inputFile2"+  deleteFile' "alreadyExistsD/bar/inputFile3"+  deleteDir' "alreadyExistsD/foo"+  deleteDir' "alreadyExistsD/bar"+  deleteDir' "alreadyExistsD"++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.copyDirRecursive" $ do++    -- successes --+    it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do+      copyDirRecursive' "inputDir"+                        "outputDir"+                        Overwrite+                        FailEarly+      removeDirIfExists "outputDir"++    it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do+      tmpDir' <- getRawTmpDir+      copyDirRecursive' "inputDir"+                        "outputDir"+                        Overwrite+                        FailEarly+      (system $ "diff -r --no-dereference "+                          ++ toString tmpDir' ++ "inputDir" ++ " "+                          ++ toString tmpDir' ++ "outputDir"+                          ++ " >/dev/null")+        `shouldReturn` ExitSuccess+      removeDirIfExists "outputDir"++    it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do+      tmpDir' <- getRawTmpDir+      (system $ "diff -r --no-dereference "+                          ++ toString tmpDir' ++ "inputDir" ++ " "+                          ++ toString tmpDir' ++ "alreadyExistsD"+                          ++ " >/dev/null")+        `shouldReturn` (ExitFailure 1)+      copyDirRecursive' "inputDir"+                        "alreadyExistsD"+                        Overwrite+                        FailEarly+      (system $ "diff -r --no-dereference "+                          ++ toString tmpDir' ++ "inputDir" ++ " "+                          ++ toString tmpDir' ++ "alreadyExistsD"+                          ++ " >/dev/null")+        `shouldReturn` ExitSuccess+      removeDirIfExists "outputDir"+++    -- posix failures --+    it "copyDirRecursive, source directory does not exist" $+      copyDirRecursive' "doesNotExist"+                        "outputDir"+                        Overwrite+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyDirRecursive, no write permission on output dir" $+      copyDirRecursive' "inputDir"+                        "noWritePerm/foo"+                        Overwrite+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive, cannot open output dir" $+      copyDirRecursive' "inputDir"+                        "noPerms/foo"+                        Overwrite+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive, cannot open source dir" $+      copyDirRecursive' "noPerms/inputDir"+                        "foo"+                        Overwrite+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive, destination already exists and is a file" $+      copyDirRecursive' "inputDir"+                        "alreadyExists"+                        Overwrite+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyDirRecursive, wrong input (regular file)" $+      copyDirRecursive' "wrongInput"+                        "outputDir"+                        Overwrite+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyDirRecursive, wrong input (symlink to directory)" $+      copyDirRecursive' "wrongInputSymL"+                        "outputDir"+                        Overwrite+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    -- custom failures+    it "copyDirRecursive (Overwrite, FailEarly), destination in source" $+      copyDirRecursive' "inputDir"+                        "inputDir/foo"+                        Overwrite+                        FailEarly+        `shouldThrow`+        isDestinationInSource++    it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $+      copyDirRecursive' "inputDir"+                        "inputDir"+                        Overwrite+                        FailEarly+        `shouldThrow`+        isSameFile
+ test/HPath/IO/CopyDirRecursiveSpec.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.CopyDirRecursiveSpec where+++import Test.Hspec+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Exit+import System.Process+import Utils+import Data.ByteString.UTF8 (toString)++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CopyDirRecursiveSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "alreadyExists"+  createRegularFile' "wrongInput"+  createSymlink' "wrongInputSymL" "inputDir/"+  createDir' "alreadyExistsD"+  createDir' "noPerms"+  createDir' "noWritePerm"++  createDir' "inputDir"+  createDir' "inputDir/bar"+  createDir' "inputDir/foo"+  createRegularFile' "inputDir/foo/inputFile1"+  createRegularFile' "inputDir/inputFile2"+  createRegularFile' "inputDir/bar/inputFile3"+  writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"+  writeFile' "inputDir/inputFile2" "Blahfaselgagaga"+  writeFile' "inputDir/bar/inputFile3"+    "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"++  noPerms "noPerms"+  noWritableDirPerms "noWritePerm"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerm"+  deleteFile' "alreadyExists"+  deleteFile' "wrongInput"+  deleteFile' "wrongInputSymL"+  deleteDir' "alreadyExistsD"+  deleteDir' "noPerms"+  deleteDir' "noWritePerm"+  deleteFile' "inputDir/foo/inputFile1"+  deleteFile' "inputDir/inputFile2"+  deleteFile' "inputDir/bar/inputFile3"+  deleteDir' "inputDir/foo"+  deleteDir' "inputDir/bar"+  deleteDir' "inputDir"+++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.copyDirRecursive" $ do++    -- successes --+    it "copyDirRecursive (Strict, FailEarly), all fine" $ do+      copyDirRecursive' "inputDir"+                        "outputDir"+                        Strict+                        FailEarly+      removeDirIfExists "outputDir"++    it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do+      tmpDir' <- getRawTmpDir+      copyDirRecursive' "inputDir"+                        "outputDir"+                        Strict+                        FailEarly+      (system $ "diff -r --no-dereference "+                          ++ toString tmpDir' ++ "inputDir" ++ " "+                          ++ toString tmpDir' ++ "outputDir"+                          ++ " >/dev/null")+        `shouldReturn` ExitSuccess+      removeDirIfExists "outputDir"++    -- posix failures --+    it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $+      copyDirRecursive' "doesNotExist"+                        "outputDir"+                        Strict+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $+      copyDirRecursive' "inputDir"+                        "noWritePerm/foo"+                        Strict+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $+      copyDirRecursive' "inputDir"+                        "noPerms/foo"+                        Strict+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $+      copyDirRecursive' "noPerms/inputDir"+                        "foo"+                        Strict+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $+      copyDirRecursive' "inputDir"+                        "alreadyExistsD"+                        Strict+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $+      copyDirRecursive' "inputDir"+                        "alreadyExists"+                        Strict+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $+      copyDirRecursive' "wrongInput"+                        "outputDir"+                        Strict+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $+      copyDirRecursive' "wrongInputSymL"+                        "outputDir"+                        Strict+                        FailEarly+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    -- custom failures+    it "copyDirRecursive (Strict, FailEarly), destination in source" $+      copyDirRecursive' "inputDir"+                        "inputDir/foo"+                        Strict+                        FailEarly+        `shouldThrow`+        isDestinationInSource++    it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $+      copyDirRecursive' "inputDir"+                        "inputDir"+                        Strict+                        FailEarly+        `shouldThrow`+        isSameFile++
+ test/HPath/IO/CopyFileOverwriteSpec.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CopyFileOverwriteSpec where+++import Test.Hspec+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Exit+import System.Process+import Utils+import Data.ByteString.UTF8 (toString)++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CopyFileOverwriteSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "inputFile"+  createRegularFile' "alreadyExists"+  createSymlink' "inputFileSymL" "inputFile"+  createDir' "alreadyExistsD"+  createDir' "noPerms"+  createRegularFile' "noPerms/inputFile"+  createDir' "outputDirNoWrite"+  createDir' "wrongInput"+  noPerms "noPerms"+  noWritableDirPerms "outputDirNoWrite"+  writeFile' "inputFile" "Blahfaselgagaga"+  writeFile' "alreadyExists" "dsaldsalkaklsdlkasksdadasl"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "outputDirNoWrite"+  deleteFile' "noPerms/inputFile"+  deleteFile' "inputFile"+  deleteFile' "alreadyExists"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  deleteDir' "noPerms"+  deleteDir' "outputDirNoWrite"+  deleteDir' "wrongInput"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.copyFile" $ do++    -- successes --+    it "copyFile (Overwrite), everything clear" $ do+      copyFile' "inputFile"+                "outputFile"+                Overwrite+      removeFileIfExists "outputFile"++    it "copyFile (Overwrite), output file already exists, all clear" $ do+      tmpDir' <- getRawTmpDir+      copyFile' "alreadyExists" "alreadyExists.bak" Strict+      copyFile' "inputFile" "alreadyExists" Overwrite+      (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "+                          ++ toString tmpDir' ++ "alreadyExists")+        `shouldReturn` ExitSuccess+      removeFileIfExists "alreadyExists"+      copyFile' "alreadyExists.bak" "alreadyExists" Strict+      removeFileIfExists "alreadyExists.bak"++    it "copyFile (Overwrite), and compare" $ do+      tmpDir' <- getRawTmpDir+      copyFile' "inputFile"+                "outputFile"+                Overwrite+      (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "+                          ++ toString tmpDir' ++ "outputFile")+        `shouldReturn` ExitSuccess+      removeFileIfExists "outputFile"+++    -- posix failures --+    it "copyFile (Overwrite), input file does not exist" $+      copyFile' "noSuchFile"+                "outputFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyFile (Overwrite), no permission to write to output directory" $+      copyFile' "inputFile"+                "outputDirNoWrite/outputFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile (Overwrite), cannot open output directory" $+      copyFile' "inputFile"+                "noPerms/outputFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile (Overwrite), cannot open source directory" $+      copyFile' "noPerms/inputFile"+                "outputFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile (Overwrite), wrong input type (symlink)" $+      copyFile' "inputFileSymL"+                "outputFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "copyFile (Overwrite), wrong input type (directory)" $+      copyFile' "wrongInput"+                "outputFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyFile (Overwrite), output file already exists and is a dir" $+      copyFile' "inputFile"+                "alreadyExistsD"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    -- custom failures --+    it "copyFile (Overwrite), output and input are same file" $+      copyFile' "inputFile"+                "inputFile"+                Overwrite+        `shouldThrow` isSameFile
+ test/HPath/IO/CopyFileSpec.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.CopyFileSpec where+++import Test.Hspec+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import System.Exit+import System.Process+import Utils+import Data.ByteString.UTF8 (toString)++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CopyFileSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "inputFile"+  createRegularFile' "alreadyExists"+  createSymlink' "inputFileSymL" "inputFile"+  createDir' "alreadyExistsD"+  createDir' "noPerms"+  createRegularFile' "noPerms/inputFile"+  createDir' "outputDirNoWrite"+  createDir' "wrongInput"+  noPerms "noPerms"+  noWritableDirPerms "outputDirNoWrite"+  writeFile' "inputFile" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "outputDirNoWrite"+  deleteFile' "noPerms/inputFile"+  deleteFile' "inputFile"+  deleteFile' "alreadyExists"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  deleteDir' "noPerms"+  deleteDir' "outputDirNoWrite"+  deleteDir' "wrongInput"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.copyFile" $ do++    -- successes --+    it "copyFile (Strict), everything clear" $ do+      copyFile' "inputFile"+                "outputFile"+                Strict+      removeFileIfExists "outputFile"++    it "copyFile (Strict), and compare" $ do+      tmpDir' <- getRawTmpDir+      copyFile' "inputFile"+                "outputFile"+                Strict+      (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "+                          ++ toString tmpDir' ++ "outputFile")+        `shouldReturn` ExitSuccess+      removeFileIfExists "outputFile"++    -- posix failures --+    it "copyFile (Strict), input file does not exist" $+      copyFile' "noSuchFile"+                "outputFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "copyFile (Strict), no permission to write to output directory" $+      copyFile' "inputFile"+                "outputDirNoWrite/outputFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile (Strict), cannot open output directory" $+      copyFile' "inputFile"+                "noPerms/outputFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile (Strict), cannot open source directory" $+      copyFile' "noPerms/inputFile"+                "outputFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "copyFile (Strict), wrong input type (symlink)" $+      copyFile' "inputFileSymL"+                "outputFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "copyFile (Strict), wrong input type (directory)" $+      copyFile' "wrongInput"+                "outputFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "copyFile (Strict), output file already exists" $+      copyFile' "inputFile"+                "alreadyExists"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "copyFile (Strict), output file already exists and is a dir" $+      copyFile' "inputFile"+                "alreadyExistsD"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    -- custom failures --+    it "copyFile (Strict), output and input are same file" $+      copyFile' "inputFile"+                "inputFile"+                Strict+        `shouldThrow`+        isSameFile
+ test/HPath/IO/CreateDirRecursiveSpec.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CreateDirRecursiveSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CreateDirRecursiveSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createDir' "alreadyExists"+  createRegularFile' "alreadyExistsF"+  createDir' "noPerms"+  createDir' "noWritePerms"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerms"++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerms"+  deleteDir' "alreadyExists"+  deleteDir' "noPerms"+  deleteDir' "noWritePerms"+  deleteFile' "alreadyExistsF"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.createDirRecursive" $ do++    -- successes --+    it "createDirRecursive, all fine" $ do+      createDirRecursive' "newDir"+      deleteDir' "newDir"++    it "createDirRecursive, parent directories do not exist" $ do+      createDirRecursive' "some/thing/dada"+      deleteDir' "some/thing/dada"+      deleteDir' "some/thing"+      deleteDir' "some"++    it "createDirRecursive, destination directory already exists" $+      createDirRecursive' "alreadyExists"++    -- posix failures --+    it "createDirRecursive, destination already exists and is a file" $+      createDirRecursive' "alreadyExistsF"+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "createDirRecursive, can't write to output directory" $+      createDirRecursive' "noWritePerms/newDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createDirRecursive, can't open output directory" $+      createDirRecursive' "noPerms/newDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+++
+ test/HPath/IO/CreateDirSpec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CreateDirSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CreateDirSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createDir' "alreadyExists"+  createDir' "noPerms"+  createDir' "noWritePerms"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerms"++++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerms"+  deleteDir' "alreadyExists"+  deleteDir' "noPerms"+  deleteDir' "noWritePerms"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.createDir" $ do++    -- successes --+    it "createDir, all fine" $ do+      createDir' "newDir"+      removeDirIfExists "newDir"++    -- posix failures --+    it "createDir, parent directories do not exist" $+      createDir' "some/thing/dada"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "createDir, can't write to output directory" $+      createDir' "noWritePerms/newDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createDir, can't open output directory" $+      createDir' "noPerms/newDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createDir, destination directory already exists" $+      createDir' "alreadyExists"+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)+
+ test/HPath/IO/CreateRegularFileSpec.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CreateRegularFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CreateRegularFileSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "alreadyExists"+  createDir' "noPerms"+  createDir' "noWritePerms"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerms"++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerms"+  deleteFile' "alreadyExists"+  deleteDir' "noPerms"+  deleteDir' "noWritePerms"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.createRegularFile" $ do++    -- successes --+    it "createRegularFile, all fine" $ do+      createRegularFile' "newDir"+      removeFileIfExists "newDir"++    -- posix failures --+    it "createRegularFile, parent directories do not exist" $+      createRegularFile' "some/thing/dada"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "createRegularFile, can't write to destination directory" $+      createRegularFile' "noWritePerms/newDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createRegularFile, can't write to destination directory" $+      createRegularFile' "noPerms/newDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createRegularFile, destination file already exists" $+      createRegularFile' "alreadyExists"+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)+
+ test/HPath/IO/CreateSymlinkSpec.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.CreateSymlinkSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "CreateSymlinkSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "alreadyExists"+  createDir' "noPerms"+  createDir' "noWritePerms"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerms"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerms"+  deleteFile' "alreadyExists"+  deleteDir' "noPerms"+  deleteDir' "noWritePerms"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.createSymlink" $ do++    -- successes --+    it "createSymlink, all fine" $ do+      createSymlink' "newSymL" "alreadyExists/"+      removeFileIfExists "newSymL"++    -- posix failures --+    it "createSymlink, parent directories do not exist" $+      createSymlink' "some/thing/dada" "lala"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "createSymlink, can't write to destination directory" $+      createSymlink' "noWritePerms/newDir" "lala"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createSymlink, can't write to destination directory" $+      createSymlink' "noPerms/newDir" "lala"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "createSymlink, destination file already exists" $+      createSymlink' "alreadyExists" "lala"+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)+
+ test/HPath/IO/DeleteDirRecursiveSpec.hs view
@@ -0,0 +1,116 @@+{-# 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++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "DeleteDirRecursiveSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "file"+  createDir' "dir"+  createRegularFile' "dir/.keep"+  createSymlink' "dirSym" "dir/"+  createDir' "noPerms"+  createRegularFile' "noPerms/.keep"+  createDir' "noWritable"+  createRegularFile' "noWritable/.keep"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "file"+  deleteFile' "dir/.keep"+  deleteDir' "dir"+  deleteFile' "dirSym"+  deleteFile' "noPerms/.keep"+  deleteDir' "noPerms"+  deleteFile' "noWritable/.keep"+  deleteDir' "noWritable"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.deleteDirRecursive" $ do++    -- successes --+    it "deleteDirRecursive, empty directory, all fine" $ do+      createDir' "testDir"+      deleteDirRecursive' "testDir"+      getSymbolicLinkStatus "testDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteDirRecursive, empty directory with null permissions, all fine" $ do+      createDir' "noPerms/testDir"+      noPerms "noPerms/testDir"+      deleteDirRecursive' "noPerms/testDir"++    it "deleteDirRecursive, non-empty directory, all fine" $ do+      createDir' "nonEmpty"+      createDir' "nonEmpty/dir1"+      createDir' "nonEmpty/dir2"+      createDir' "nonEmpty/dir2/dir3"+      createRegularFile' "nonEmpty/file1"+      createRegularFile' "nonEmpty/dir1/file2"+      deleteDirRecursive' "nonEmpty"+      getSymbolicLinkStatus "nonEmpty"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    -- posix failures --+    it "deleteDirRecursive, can't open parent directory" $ do+      createDir' "noPerms/foo"+      noPerms "noPerms"+      (deleteDirRecursive' "noPerms/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+      normalDirPerms "noPerms"+      deleteDir' "noPerms/foo"++    it "deleteDirRecursive, can't write to parent directory" $ do+      createDir' "noWritable/foo"+      noWritableDirPerms "noWritable"+      (deleteDirRecursive' "noWritable/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+      normalDirPerms "noWritable"+      deleteDir' "noWritable/foo"++    it "deleteDirRecursive, wrong file type (symlink to directory)" $+      deleteDirRecursive' "dirSym"+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteDirRecursive, wrong file type (regular file)" $+      deleteDirRecursive' "file"+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteDirRecursive, directory does not exist" $+      deleteDirRecursive' "doesNotExist"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++
+ test/HPath/IO/DeleteDirSpec.hs view
@@ -0,0 +1,114 @@+{-# 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+++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "DeleteDirSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "file"+  createDir' "dir"+  createRegularFile' "dir/.keep"+  createSymlink' "dirSym" "dir/"+  createDir' "noPerms"+  createRegularFile' "noPerms/.keep"+  createDir' "noWritable"+  createRegularFile' "noWritable/.keep"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "file"+  deleteFile' "dir/.keep"+  deleteDir' "dir"+  deleteFile' "dirSym"+  deleteFile' "noPerms/.keep"+  deleteDir' "noPerms"+  deleteFile' "noWritable/.keep"+  deleteDir' "noWritable"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.deleteDir" $ do++    -- successes --+    it "deleteDir, empty directory, all fine" $ do+      createDir' "testDir"+      deleteDir' "testDir"+      getSymbolicLinkStatus "testDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteDir, directory with null permissions, all fine" $ do+      createDir' "noPerms/testDir"+      noPerms "noPerms/testDir"+      deleteDir' "noPerms/testDir"+      getSymbolicLinkStatus "testDir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    -- posix failures --+    it "deleteDir, wrong file type (symlink to directory)" $+      deleteDir' "dirSym"+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteDir, wrong file type (regular file)" $+      deleteDir' "file"+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteDir, directory does not exist" $+      deleteDir' "doesNotExist"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteDir, directory not empty" $+      deleteDir' "dir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == UnsatisfiedConstraints)++    it "deleteDir, can't open parent directory" $ do+      createDir' "noPerms/foo"+      noPerms "noPerms"+      (deleteDir' "noPerms/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+      normalDirPerms "noPerms"+      deleteDir' "noPerms/foo"++    it "deleteDir, can't write to parent directory, still fine" $ do+      createDir' "noWritable/foo"+      noWritableDirPerms "noWritable"+      (deleteDir' "noWritable/foo")+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+      normalDirPerms "noWritable"+      deleteDir' "noWritable/foo"+++
+ test/HPath/IO/DeleteFileSpec.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.DeleteFileSpec where+++import Test.Hspec+import HPath.IO+import System.IO.Error+  (+    ioeGetErrorType+  )+import System.Posix.Files.ByteString+  (+    getSymbolicLinkStatus+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "DeleteFileSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "foo"+  createSymlink' "syml" "foo"+  createDir' "dir"+  createDir' "noPerms"+  noPerms "noPerms"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  deleteFile' "foo"+  deleteFile' "syml"+  deleteDir' "dir"+  deleteDir' "noPerms"++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.deleteFile" $ do++    -- successes --+    it "deleteFile, regular file, all fine" $ do+      createRegularFile' "testFile"+      deleteFile' "testFile"+      getSymbolicLinkStatus "testFile"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteFile, symlink, all fine" $ do+      recreateSymlink' "syml"+                       "testFile"+                       Strict+      deleteFile' "testFile"+      getSymbolicLinkStatus "testFile"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    -- posix failures --+    it "deleteFile, wrong file type (directory)" $+      deleteFile' "dir"+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "deleteFile, file does not exist" $+      deleteFile' "doesNotExist"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "deleteFile, can't read directory" $+      deleteFile' "noPerms/blah"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+
+ test/HPath/IO/GetDirsFilesSpec.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.GetDirsFilesSpec where+++import Data.List+  (+    sort+  )+import qualified HPath as P+import HPath.IO+import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "GetDirsFilesSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "file"+  createRegularFile' "Lala"+  createRegularFile' ".hidden"+  createSymlink' "syml" "Lala"+  createDir' "dir"+  createSymlink' "dirsym" "dir"+  createDir' "noPerms"+  noPerms "noPerms"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  deleteFile' "file"+  deleteFile' "Lala"+  deleteFile' ".hidden"+  deleteFile' "syml"+  deleteDir' "dir"+  deleteFile' "dirsym"+  deleteDir' "noPerms"++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.getDirsFiles" $ do++    -- successes --+    it "getDirsFiles, all fine" $+      withRawTmpDir $ \p -> do+      expectedFiles <- mapM P.parseRel [".hidden"+                                       ,"Lala"+                                       ,"dir"+                                       ,"dirsym"+                                       ,"file"+                                       ,"noPerms"+                                       ,"syml"]+      (fmap sort $ getDirsFiles p)+        `shouldReturn` fmap (p P.</>) expectedFiles++    -- posix failures --+    it "getDirsFiles, nonexistent directory" $+      getDirsFiles' "nothingHere"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "getDirsFiles, wrong file type (file)" $+      getDirsFiles' "file"+        `shouldThrow`+        (\e -> ioeGetErrorType e == InappropriateType)++    it "getDirsFiles, wrong file type (symlink to file)" $+      getDirsFiles' "syml"+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "getDirsFiles, wrong file type (symlink to dir)" $+      getDirsFiles' "dirsym"+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "getDirsFiles, can't open directory" $+      getDirsFiles' "noPerms"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++++
+ test/HPath/IO/GetFileTypeSpec.hs view
@@ -0,0 +1,88 @@+{-# 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++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "GetFileTypeSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "regularfile"+  createSymlink' "symlink" "regularfile"+  createSymlink' "brokenSymlink" "broken"+  createDir' "directory"+  createSymlink' "symlinkD" "directory"+  createDir' "noPerms"+  noPerms "noPerms"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  deleteFile' "regularfile"+  deleteFile' "symlink"+  deleteFile' "brokenSymlink"+  deleteDir' "directory"+  deleteFile' "symlinkD"+  deleteDir' "noPerms"++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.getFileType" $ do++    -- successes --+    it "getFileType, regular file" $+      getFileType' "regularfile"+        `shouldReturn` RegularFile++    it "getFileType, directory" $+      getFileType' "directory"+        `shouldReturn` Directory++    it "getFileType, directory with null permissions" $+      getFileType' "noPerms"+        `shouldReturn` Directory++    it "getFileType, symlink to file" $+      getFileType' "symlink"+        `shouldReturn` SymbolicLink++    it "getFileType, symlink to directory" $+      getFileType' "symlinkD"+        `shouldReturn` SymbolicLink++    it "getFileType, broken symlink" $+      getFileType' "brokenSymlink"+        `shouldReturn` SymbolicLink++    -- posix failures --+    it "getFileType, file does not exist" $+      getFileType' "nothingHere"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "getFileType, can't open directory" $+      getFileType' "noPerms/forz"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)+
+ test/HPath/IO/MoveFileOverwriteSpec.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.MoveFileOverwriteSpec where+++import Test.Hspec+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "MoveFileOverwriteSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "myFile"+  createSymlink' "myFileL" "myFile"+  createDir' "alreadyExistsD"+  createDir' "dir"+  createDir' "noPerms"+  createDir' "noWritePerm"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerm"+  writeFile' "myFile" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerm"+  deleteFile' "myFile"+  deleteFile' "myFileL"+  deleteDir' "alreadyExistsD"+  deleteDir' "dir"+  deleteDir' "noPerms"+  deleteDir' "noWritePerm"++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.moveFile" $ do++    -- successes --+    it "moveFile (Overwrite), all fine" $+      moveFile' "myFile"+                "movedFile"+                Overwrite++    it "moveFile (Overwrite), all fine" $+      moveFile' "myFile"+                "dir/movedFile"+                Overwrite++    it "moveFile (Overwrite), all fine on symlink" $+      moveFile' "myFileL"+                "movedFile"+                Overwrite++    it "moveFile (Overwrite), all fine on directory" $+      moveFile' "dir"+                "movedFile"+                Overwrite++    it "moveFile (Overwrite), destination file already exists" $+      moveFile' "myFile"+                "alreadyExists"+                Overwrite++    -- posix failures --+    it "moveFile (Overwrite), source file does not exist" $+      moveFile' "fileDoesNotExist"+                "movedFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "moveFile (Overwrite), can't write to destination directory" $+      moveFile' "myFile"+                "noWritePerm/movedFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "moveFile (Overwrite), can't open destination directory" $+      moveFile' "myFile"+                "noPerms/movedFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "moveFile (Overwrite), can't open source directory" $+      moveFile' "noPerms/myFile"+                "movedFile"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    -- custom failures --++    it "moveFile (Overwrite), move from file to dir" $+      moveFile' "myFile"+                "alreadyExistsD"+                Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "moveFile (Overwrite), source and dest are same file" $+      moveFile' "myFile"+                "myFile"+                Overwrite+        `shouldThrow`+        isSameFile
+ test/HPath/IO/MoveFileSpec.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.MoveFileSpec where+++import Test.Hspec+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "MoveFileSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "myFile"+  createSymlink' "myFileL" "myFile"+  createRegularFile' "alreadyExists"+  createDir' "alreadyExistsD"+  createDir' "dir"+  createDir' "noPerms"+  createDir' "noWritePerm"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerm"+  writeFile' "myFile" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerm"+  deleteFile' "myFile"+  deleteFile' "myFileL"+  deleteFile' "alreadyExists"+  deleteDir' "alreadyExistsD"+  deleteDir' "dir"+  deleteDir' "noPerms"+  deleteDir' "noWritePerm"++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.moveFile" $ do++    -- successes --+    it "moveFile (Strict), all fine" $+      moveFile' "myFile"+                "movedFile"+                Strict++    it "moveFile (Strict), all fine" $+      moveFile' "myFile"+                "dir/movedFile"+                Strict++    it "moveFile (Strict), all fine on symlink" $+      moveFile' "myFileL"+                "movedFile"+                Strict++    it "moveFile (Strict), all fine on directory" $+      moveFile' "dir"+                "movedFile"+                Strict++    -- posix failures --+    it "moveFile (Strict), source file does not exist" $+      moveFile' "fileDoesNotExist"+                "movedFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "moveFile (Strict), can't write to destination directory" $+      moveFile' "myFile"+                "noWritePerm/movedFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "moveFile (Strict), can't open destination directory" $+      moveFile' "myFile"+                "noPerms/movedFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "moveFile (Strict), can't open source directory" $+      moveFile' "noPerms/myFile"+                "movedFile"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    -- custom failures --+    it "moveFile (Strict), destination file already exists" $+      moveFile' "myFile"+                "alreadyExists"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "moveFile (Strict), move from file to dir" $+      moveFile' "myFile"+                "alreadyExistsD"+                Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "moveFile (Strict), source and dest are same file" $+      moveFile' "myFile"+                "myFile"+                Strict+        `shouldThrow`+        isSameFile
+ test/HPath/IO/ReadFileEOFSpec.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.ReadFileEOFSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "ReadFileEOFSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "fileWithContent"+  createRegularFile' "fileWithoutContent"+  createSymlink' "inputFileSymL" "fileWithContent"+  createDir' "alreadyExistsD"+  createRegularFile' "noPerms"+  noPerms "noPerms"+  createDir' "noPermsD"+  createRegularFile' "noPermsD/inputFile"+  noPerms "noPermsD"+  writeFile' "fileWithContent" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "fileWithContent"+  deleteFile' "fileWithoutContent"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  normalFilePerms "noPerms"+  deleteFile' "noPerms"+  normalDirPerms "noPermsD"+  deleteFile' "noPermsD/inputFile"+  deleteDir' "noPermsD"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.readFileEOF" $ do++    -- successes --+    it "readFileEOF (Strict) file with content, everything clear" $ do+      out <- readFileEOF' "fileWithContent"+      out `shouldBe` "Blahfaselgagaga"++    it "readFileEOF (Strict) symlink, everything clear" $ do+      out <- readFileEOF' "inputFileSymL"+      out `shouldBe` "Blahfaselgagaga"++    it "readFileEOF (Strict) empty file, everything clear" $ do+      out <- readFileEOF' "fileWithoutContent"+      out `shouldBe` ""+++    -- posix failures --+    it "readFileEOF (Strict) directory, wrong file type" $ do+      readFileEOF' "alreadyExistsD"+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "readFileEOF (Strict) file, no permissions" $ do+      readFileEOF' "noPerms"+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "readFileEOF (Strict) file, no permissions on dir" $ do+      readFileEOF' "noPermsD/inputFile"+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "readFileEOF (Strict) file, no such file" $ do+      readFileEOF' "lalala"+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)
+ test/HPath/IO/ReadFileSpec.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.ReadFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "ReadFileSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "fileWithContent"+  createRegularFile' "fileWithoutContent"+  createSymlink' "inputFileSymL" "fileWithContent"+  createDir' "alreadyExistsD"+  createRegularFile' "noPerms"+  noPerms "noPerms"+  createDir' "noPermsD"+  createRegularFile' "noPermsD/inputFile"+  noPerms "noPermsD"+  writeFile' "fileWithContent" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "fileWithContent"+  deleteFile' "fileWithoutContent"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  normalFilePerms "noPerms"+  deleteFile' "noPerms"+  normalDirPerms "noPermsD"+  deleteFile' "noPermsD/inputFile"+  deleteDir' "noPermsD"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.readFile" $ do++    -- successes --+    it "readFile (Strict) file with content, everything clear" $ do+      out <- readFile' "fileWithContent"+      out `shouldBe` "Blahfaselgagaga"++    it "readFile (Strict) symlink, everything clear" $ do+      out <- readFile' "inputFileSymL"+      out `shouldBe` "Blahfaselgagaga"++    it "readFile (Strict) empty file, everything clear" $ do+      out <- readFile' "fileWithoutContent"+      out `shouldBe` ""+++    -- posix failures --+    it "readFile (Strict) directory, wrong file type" $ do+      readFile' "alreadyExistsD"+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "readFile (Strict) file, no permissions" $ do+      readFile' "noPerms"+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "readFile (Strict) file, no permissions on dir" $ do+      readFile' "noPermsD/inputFile"+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "readFile (Strict) file, no such file" $ do+      readFile' "lalala"+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)
+ test/HPath/IO/RecreateSymlinkOverwriteSpec.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.RecreateSymlinkOverwriteSpec where+++-- TODO: exception if destination exists but is not a file + `OverWrite` CopyMode+++import Test.Hspec+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils+++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "RecreateSymlinkOverwriteSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "myFile"+  createSymlink' "myFileL" "myFile"+  createRegularFile' "alreadyExists"+  createDir' "alreadyExistsD"+  createDir' "dir"+  createDir' "noPerms"+  createDir' "noWritePerm"+  createDir' "alreadyExistsD2"+  createRegularFile' "alreadyExistsD2/lala"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerm"+  writeFile' "myFile" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerm"+  deleteFile' "myFile"+  deleteFile' "myFileL"+  deleteFile' "alreadyExists"+  deleteFile' "alreadyExistsD2/lala"+  deleteDir' "alreadyExistsD"+  deleteDir' "alreadyExistsD2"+  deleteDir' "dir"+  deleteDir' "noPerms"+  deleteDir' "noWritePerm"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.recreateSymlink" $ do++    -- successes --+    it "recreateSymLink (Overwrite), all fine" $ do+      recreateSymlink' "myFileL"+                       "movedFile"+                       Overwrite+      removeFileIfExists "movedFile"++    it "recreateSymLink (Overwrite), all fine" $ do+      recreateSymlink' "myFileL"+                       "dir/movedFile"+                       Overwrite+      removeFileIfExists "dir/movedFile"++    it "recreateSymLink (Overwrite), destination file already exists" $+      recreateSymlink' "myFileL"+                       "alreadyExists"+                       Overwrite++    it "recreateSymLink (Overwrite), destination already exists and is an empty dir" $ do+      recreateSymlink' "myFileL"+                       "alreadyExistsD"+                       Overwrite+      deleteFile' "alreadyExistsD"+      createDir' "alreadyExistsD"++    -- posix failures --+    it "recreateSymLink (Overwrite), destination already exists and is a non-empty dir" $+      recreateSymlink' "myFileL"+                       "alreadyExistsD2"+                       Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == UnsatisfiedConstraints)++    it "recreateSymLink (Overwrite), wrong input type (file)" $+      recreateSymlink' "myFile"+                       "movedFile"+                       Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "recreateSymLink (Overwrite), wrong input type (directory)" $+      recreateSymlink' "dir"+                       "movedFile"+                       Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "recreateSymLink (Overwrite), can't write to destination directory" $+      recreateSymlink' "myFileL"+                       "noWritePerm/movedFile"+                       Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "recreateSymLink (Overwrite), can't open destination directory" $+      recreateSymlink' "myFileL"+                       "noPerms/movedFile"+                       Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "recreateSymLink (Overwrite), can't open source directory" $+      recreateSymlink' "noPerms/myFileL"+                       "movedFile"+                       Overwrite+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    -- custom failures --+    it "recreateSymLink (Overwrite), source and destination are the same file" $+      recreateSymlink' "myFileL"+                       "myFileL"+                       Overwrite+        `shouldThrow`+        isSameFile+
+ test/HPath/IO/RecreateSymlinkSpec.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverloadedStrings #-}++module HPath.IO.RecreateSymlinkSpec where+++++import Test.Hspec+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "RecreateSymlinkSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "myFile"+  createSymlink' "myFileL" "myFile"+  createRegularFile' "alreadyExists"+  createDir' "alreadyExistsD"+  createDir' "dir"+  createDir' "noPerms"+  createDir' "noWritePerm"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerm"+  writeFile' "myFile" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerm"+  deleteFile' "myFile"+  deleteFile' "myFileL"+  deleteFile' "alreadyExists"+  deleteDir' "alreadyExistsD"+  deleteDir' "dir"+  deleteDir' "noPerms"+  deleteDir' "noWritePerm"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.recreateSymlink" $ do++    -- successes --+    it "recreateSymLink (Strict), all fine" $ do+      recreateSymlink' "myFileL"+                       "movedFile"+                       Strict+      removeFileIfExists "movedFile"++    it "recreateSymLink (Strict), all fine" $ do+      recreateSymlink' "myFileL"+                       "dir/movedFile"+                       Strict+      removeFileIfExists "dir/movedFile"++    -- posix failures --+    it "recreateSymLink (Strict), wrong input type (file)" $+      recreateSymlink' "myFile"+                       "movedFile"+                       Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "recreateSymLink (Strict), wrong input type (directory)" $+      recreateSymlink' "dir"+                       "movedFile"+                       Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == InvalidArgument)++    it "recreateSymLink (Strict), can't write to destination directory" $+      recreateSymlink' "myFileL"+                       "noWritePerm/movedFile"+                       Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "recreateSymLink (Strict), can't open destination directory" $+      recreateSymlink' "myFileL"+                       "noPerms/movedFile"+                       Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "recreateSymLink (Strict), can't open source directory" $+      recreateSymlink' "noPerms/myFileL"+                       "movedFile"+                       Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "recreateSymLink (Strict), destination file already exists" $+      recreateSymlink' "myFileL"+                       "alreadyExists"+                       Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "recreateSymLink (Strict), destination already exists and is a dir" $+      recreateSymlink' "myFileL"+                       "alreadyExistsD"+                       Strict+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    -- custom failures --+    it "recreateSymLink (Strict), source and destination are the same file" $+      recreateSymlink' "myFileL"+                       "myFileL"+                       Strict+        `shouldThrow`+        isSameFile+
+ test/HPath/IO/RenameFileSpec.hs view
@@ -0,0 +1,117 @@+{-# 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++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "RenameFileSpec"+  createTmpDir+++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "myFile"+  createSymlink' "myFileL" "myFile"+  createRegularFile' "alreadyExists"+  createDir' "alreadyExistsD"+  createDir' "dir"+  createDir' "noPerms"+  createDir' "noWritePerm"+  noPerms "noPerms"+  noWritableDirPerms "noWritePerm"+  writeFile' "myFile" "Blahfaselgagaga"+++cleanupFiles :: IO ()+cleanupFiles = do+  normalDirPerms "noPerms"+  normalDirPerms "noWritePerm"+  deleteFile' "myFile"+  deleteFile' "myFileL"+  deleteFile' "alreadyExists"+  deleteDir' "alreadyExistsD"+  deleteDir' "dir"+  deleteDir' "noPerms"+  deleteDir' "noWritePerm"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.renameFile" $ do++    -- successes --+    it "renameFile, all fine" $+      renameFile' "myFile"+                  "renamedFile"++    it "renameFile, all fine" $+      renameFile' "myFile"+                  "dir/renamedFile"++    it "renameFile, all fine on symlink" $+      renameFile' "myFileL"+                  "renamedFile"++    it "renameFile, all fine on directory" $+      renameFile' "dir"+                  "renamedFile"++    -- posix failures --+    it "renameFile, source file does not exist" $+      renameFile' "fileDoesNotExist"+                  "renamedFile"+        `shouldThrow`+        (\e -> ioeGetErrorType e == NoSuchThing)++    it "renameFile, can't write to output directory" $+      renameFile' "myFile"+                  "noWritePerm/renamedFile"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "renameFile, can't open output directory" $+      renameFile' "myFile"+                  "noPerms/renamedFile"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    it "renameFile, can't open source directory" $+      renameFile' "noPerms/myFile"+                  "renamedFile"+        `shouldThrow`+        (\e -> ioeGetErrorType e == PermissionDenied)++    -- custom failures --+    it "renameFile, destination file already exists" $+      renameFile' "myFile"+                  "alreadyExists"+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "renameFile, move from file to dir" $+      renameFile' "myFile"+                  "alreadyExistsD"+        `shouldThrow`+        (\e -> ioeGetErrorType e == AlreadyExists)++    it "renameFile, source and dest are same file" $+      renameFile' "myFile"+                  "myFile"+        `shouldThrow`+        isSameFile+
+ test/HPath/IO/ToAbsSpec.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.ToAbsSpec where+++import Test.Hspec+import HPath+import HPath.IO++++spec :: Spec+spec = describe "HPath.IO.toAbs" $ do++    -- successes --+    it "toAbs returns absolute paths unchanged" $ do+      p1 <- parseAbs "/a/b/c/d"+      to <- toAbs p1+      p1 `shouldBe` to++    it "toAbs returns even existing absolute paths unchanged" $ do+      p1 <- parseAbs "/home"+      to <- toAbs p1+      p1 `shouldBe` to++
+ test/HPath/IO/WriteFileSpec.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.WriteFileSpec where+++import Test.Hspec+import System.IO.Error+  (+    ioeGetErrorType+  )+import GHC.IO.Exception+  (+    IOErrorType(..)+  )+import Utils++++upTmpDir :: IO ()+upTmpDir = do+  setTmpDir "WriteFileSpec"+  createTmpDir++setupFiles :: IO ()+setupFiles = do+  createRegularFile' "fileWithContent"+  createRegularFile' "fileWithoutContent"+  createSymlink' "inputFileSymL" "fileWithContent"+  createDir' "alreadyExistsD"+  createRegularFile' "noPerms"+  noPerms "noPerms"+  createDir' "noPermsD"+  createRegularFile' "noPermsD/inputFile"+  noPerms "noPermsD"+  writeFile' "fileWithContent" "BLKASL"+++cleanupFiles :: IO ()+cleanupFiles = do+  deleteFile' "fileWithContent"+  deleteFile' "fileWithoutContent"+  deleteFile' "inputFileSymL"+  deleteDir' "alreadyExistsD"+  normalFilePerms "noPerms"+  deleteFile' "noPerms"+  normalDirPerms "noPermsD"+  deleteFile' "noPermsD/inputFile"+  deleteDir' "noPermsD"+++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+  describe "HPath.IO.writeFile" $ do++    -- successes --+    it "writeFile file with content, everything clear" $ do+      writeFile' "fileWithContent" "blahfaselllll"+      out <- readFile' "fileWithContent"+      out `shouldBe` "blahfaselllll"++    it "writeFile file with content, everything clear" $ do+      writeFile' "fileWithContent" "gagagaga"+      out <- readFile' "fileWithContent"+      out `shouldBe` "gagagaga"++    it "writeFile file with content, everything clear" $ do+      writeFile' "fileWithContent" ""+      out <- readFile' "fileWithContent"+      out `shouldBe` ""++    it "writeFile file without content, everything clear" $ do+      writeFile' "fileWithoutContent" "blahfaselllll"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "blahfaselllll"++    it "writeFile, everything clear" $ do+      writeFile' "fileWithoutContent" "gagagaga"+      out <- readFile' "fileWithoutContent"+      out `shouldBe` "gagagaga"++    it "writeFile symlink, everything clear" $ do+      writeFile' "inputFileSymL" "blahfaselllll"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "blahfaselllll"++    it "writeFile symlink, everything clear" $ do+      writeFile' "inputFileSymL" "gagagaga"+      out <- readFile' "inputFileSymL"+      out `shouldBe` "gagagaga"+++    -- posix failures --+    it "writeFile to dir, inappropriate type" $ do+      writeFile' "alreadyExistsD" ""+        `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType)++    it "writeFile, no permissions to file" $ do+      writeFile' "noPerms" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "writeFile, no permissions to file" $ do+      writeFile' "noPermsD/inputFile" ""+        `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied)++    it "writeFile, file does not exist" $ do+      writeFile' "gaga" ""+        `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing)
+ test/Main.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString as BS+import Data.IORef+import Test.Hspec+import Test.Hspec.Runner+import Test.Hspec.Formatters+import qualified Spec+import Utils+import System.Posix.Temp.ByteString (mkdtemp)+++-- TODO: chardev, blockdev, namedpipe, socket+++main :: IO ()+main = do+  tmpBase <- mkdtemp "/tmp/"+  writeIORef baseTmpDir (Just (tmpBase `BS.append` "/"))+  putStrLn $ ("Temporary test directory at: " ++ show tmpBase)+  hspecWith+    defaultConfig { configFormatter = Just progress }+    $ afterAll_ deleteBaseTmpDir+    $ Spec.spec
+ 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,290 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+++module Utils where+++import Control.Applicative+  (+    (<$>)+  )+import Control.Monad+  (+    forM_+  , void+  )+import Control.Monad.IfElse+  (+    whenM+  )+import qualified Data.ByteString as BS+import Data.IORef+  (+    newIORef+  , readIORef+  , writeIORef+  , IORef+  )+import HPath.IO+import HPath.IO.Errors+import Prelude hiding (appendFile, readFile, writeFile)+import Data.Maybe+  (+    fromJust+  )+import qualified HPath as P+import System.IO.Unsafe+  (+    unsafePerformIO+  )+import qualified System.Posix.Directory.Traversals as DT+import Data.ByteString+  (+    ByteString+  )+import qualified Data.ByteString.Lazy as L+import System.Posix.Files.ByteString+  (+    groupExecuteMode+  , groupReadMode+  , nullFileMode+  , otherExecuteMode+  , otherReadMode+  , ownerExecuteMode+  , ownerReadMode+  , setFileMode+  , unionFileModes+  )++baseTmpDir :: IORef (Maybe ByteString)+{-# NOINLINE baseTmpDir #-}+baseTmpDir = unsafePerformIO (newIORef Nothing)+++tmpDir :: IORef (Maybe ByteString)+{-# NOINLINE tmpDir #-}+tmpDir = unsafePerformIO (newIORef Nothing)++++    -----------------+    --[ Utilities ]--+    -----------------+++setTmpDir :: ByteString -> IO ()+{-# NOINLINE setTmpDir #-}+setTmpDir bs = do+  tmp <- fromJust <$> readIORef baseTmpDir+  writeIORef tmpDir (Just (tmp `BS.append` bs))+++createTmpDir :: IO ()+{-# NOINLINE createTmpDir #-}+createTmpDir = do+  tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)+  void $ createDir newDirPerms tmp+++deleteTmpDir :: IO ()+{-# NOINLINE deleteTmpDir #-}+deleteTmpDir = do+  tmp <- P.parseAbs  =<< (fromJust <$> readIORef tmpDir)+  void $ deleteDir tmp+++deleteBaseTmpDir :: IO ()+{-# NOINLINE deleteBaseTmpDir #-}+deleteBaseTmpDir = do+  tmp <- (fromJust <$> readIORef baseTmpDir) >>= P.parseAbs+  contents <- getDirsFiles tmp+  forM_ contents deleteDir+  void $ deleteDir tmp+++withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a+{-# NOINLINE withRawTmpDir #-}+withRawTmpDir f = do+  tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)+  f tmp+++getRawTmpDir :: IO ByteString+{-# NOINLINE getRawTmpDir #-}+getRawTmpDir = withRawTmpDir (return . flip BS.append "/" . P.fromAbs)+++withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a+{-# NOINLINE withTmpDir #-}+withTmpDir ip f = do+  tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)+  p <- (tmp P.</>) <$> P.parseRel ip+  f p+++withTmpDir' :: ByteString+            -> ByteString+            -> (P.Path P.Abs -> P.Path P.Abs -> IO a)+            -> IO a+{-# NOINLINE withTmpDir' #-}+withTmpDir' ip1 ip2 f = do+  tmp <- P.parseAbs =<< (fromJust <$> readIORef tmpDir)+  p1 <- (tmp P.</>) <$> P.parseRel ip1+  p2 <- (tmp P.</>) <$> P.parseRel ip2+  f p1 p2+++removeFileIfExists :: ByteString -> IO ()+{-# NOINLINE removeFileIfExists #-}+removeFileIfExists bs =+  withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p)+++removeDirIfExists :: ByteString -> IO ()+{-# NOINLINE removeDirIfExists #-}+removeDirIfExists bs =+  withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)+++copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()+{-# NOINLINE copyFile' #-}+copyFile' inputFileP outputFileP cm =+  withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm)+++copyDirRecursive' :: ByteString -> ByteString+                  -> CopyMode -> RecursiveErrorMode -> IO ()+{-# NOINLINE copyDirRecursive' #-}+copyDirRecursive' inputDirP outputDirP cm rm =+  withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm)+++createDir' :: ByteString -> IO ()+{-# NOINLINE createDir' #-}+createDir' dest = withTmpDir dest (createDir newDirPerms)++createDirRecursive' :: ByteString -> IO ()+{-# NOINLINE createDirRecursive' #-}+createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms)++createRegularFile' :: ByteString -> IO ()+{-# NOINLINE createRegularFile' #-}+createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms)+++createSymlink' :: ByteString -> ByteString -> IO ()+{-# NOINLINE createSymlink' #-}+createSymlink' dest sympoint = withTmpDir dest+  (\x -> createSymlink x sympoint)+++renameFile' :: ByteString -> ByteString -> IO ()+{-# NOINLINE renameFile' #-}+renameFile' inputFileP outputFileP =+  withTmpDir' inputFileP outputFileP $ \i o -> do+    renameFile i o+    renameFile o i+++moveFile' :: ByteString -> ByteString -> CopyMode -> IO ()+{-# NOINLINE moveFile' #-}+moveFile' inputFileP outputFileP cm =+  withTmpDir' inputFileP outputFileP $ \i o -> do+    moveFile i o cm+    moveFile o i Strict+++recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO ()+{-# NOINLINE recreateSymlink' #-}+recreateSymlink' inputFileP outputFileP cm =+  withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm)+++noWritableDirPerms :: ByteString -> IO ()+{-# NOINLINE noWritableDirPerms #-}+noWritableDirPerms path = withTmpDir path $ \p ->+  setFileMode (P.fromAbs p) perms+  where+    perms =            ownerReadMode+      `unionFileModes` ownerExecuteMode+      `unionFileModes` groupReadMode+      `unionFileModes` groupExecuteMode+      `unionFileModes` otherReadMode+      `unionFileModes` otherExecuteMode+++noPerms :: ByteString -> IO ()+{-# NOINLINE noPerms #-}+noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode+++normalDirPerms :: ByteString -> IO ()+{-# NOINLINE normalDirPerms #-}+normalDirPerms path =+  withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms+++normalFilePerms :: ByteString -> IO ()+{-# NOINLINE normalFilePerms #-}+normalFilePerms path =+  withTmpDir path $ \p -> setFileMode (P.fromAbs p) newFilePerms+++getFileType' :: ByteString -> IO FileType+{-# NOINLINE getFileType' #-}+getFileType' path = withTmpDir path getFileType+++getDirsFiles' :: ByteString -> IO [P.Path P.Abs]+{-# NOINLINE getDirsFiles' #-}+getDirsFiles' path = withTmpDir path getDirsFiles+++deleteFile' :: ByteString -> IO ()+{-# NOINLINE deleteFile' #-}+deleteFile' p = withTmpDir p deleteFile+++deleteDir' :: ByteString -> IO ()+{-# NOINLINE deleteDir' #-}+deleteDir' p = withTmpDir p deleteDir+++deleteDirRecursive' :: ByteString -> IO ()+{-# NOINLINE deleteDirRecursive' #-}+deleteDirRecursive' p = withTmpDir p deleteDirRecursive+++canonicalizePath' :: ByteString -> IO (P.Path P.Abs)+{-# NOINLINE canonicalizePath' #-}+canonicalizePath' p = withTmpDir p canonicalizePath+++writeFile' :: ByteString -> ByteString -> IO ()+{-# NOINLINE writeFile' #-}+writeFile' ip bs = +  withTmpDir ip $ \p -> writeFile p bs+++appendFile' :: ByteString -> ByteString -> IO ()+{-# NOINLINE appendFile' #-}+appendFile' ip bs =+  withTmpDir ip $ \p -> appendFile p bs+++allDirectoryContents' :: ByteString -> IO [ByteString]+{-# NOINLINE allDirectoryContents' #-}+allDirectoryContents' ip =+  withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p)+++readFile' :: ByteString -> IO ByteString+{-# NOINLINE readFile' #-}+readFile' p = withTmpDir p readFile+++readFileEOF' :: ByteString -> IO L.ByteString+{-# NOINLINE readFileEOF' #-}+readFileEOF' p = withTmpDir p readFileEOF+