hpath 0.8.0 → 0.8.1

raw patch · 15 files changed

+436/−185 lines, 15 filesdep +IfElsedep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: IfElse

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +2/−0
• hpath.cabal +4/−2
• src/HPath.hs +2/−4
• src/HPath/IO.hs +222/−45
• src/HPath/IO/Errors.hs +68/−85
• src/HPath/IO/Utils.hs +0/−32
• test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs +8/−6
• test/HPath/IO/CreateDirRecursiveSpec.hs +78/−0
• test/HPath/IO/CreateDirSpec.hs +5/−0
• test/HPath/IO/CreateRegularFileSpec.hs +5/−0
• test/HPath/IO/CreateSymlinkSpec.hs +5/−0
• test/HPath/IO/MoveFileOverwriteSpec.hs +1/−1
• test/HPath/IO/MoveFileSpec.hs +2/−2
• test/HPath/IO/RenameFileSpec.hs +2/−2
• test/Utils.hs +32/−6

@@ -1,3 +1,5 @@+0.8.1+	* add 'readFile', 'readFileEOF', 'writeFile' and 'appendFile' 0.8.0 	* 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument 	* introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior)

@@ -1,5 +1,5 @@ name:                hpath-version:             0.8.0+version:             0.8.1 synopsis:            Support for well-typed paths description:         Support for well-typed paths, utilizing ByteString under the hood. license:             BSD3@@ -27,13 +27,13 @@   exposed-modules:   HPath,                      HPath.IO,                      HPath.IO.Errors,-                     HPath.IO.Utils,                      System.Posix.Directory.Foreign,                      System.Posix.Directory.Traversals,                      System.Posix.FD,                      System.Posix.FilePath   other-modules:     HPath.Internal   build-depends:     base >= 4.2 && <5+                   , IfElse                    , bytestring >= 0.9.2.0                    , deepseq                    , exceptions@@ -82,6 +82,7 @@                         HPath.IO.CopyFileOverwriteSpec                         HPath.IO.CopyFileSpec                         HPath.IO.CreateDirSpec+                        HPath.IO.CreateDirRecursiveSpec                         HPath.IO.CreateRegularFileSpec                         HPath.IO.CreateSymlinkSpec                         HPath.IO.DeleteDirRecursiveSpec@@ -99,6 +100,7 @@   GHC-Options:          -Wall   Build-Depends:        base                       , HUnit+                      , IfElse                       , bytestring                       , hpath                       , hspec >= 1.3

@@ -314,10 +314,6 @@  -- | Extract the directory name of a path. ----- The following properties hold:------ @dirname (p \<\/> a) == dirname p@--- -- >>> dirname (MkPath "/abc/def/dod") -- "/abc/def" -- >>> dirname (MkPath "/")@@ -335,6 +331,8 @@ -- Throws: `PathException` if given the root path "/" -- -- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)+-- Just "dod"+-- >>> basename (MkPath "/abc/def/dod/") :: Maybe (Path Fn) -- Just "dod" -- >>> basename (MkPath "/")            :: Maybe (Path Fn) -- Nothing

@@ -55,10 +55,17 @@   -- * File creation   , createRegularFile   , createDir+  , createDirRecursive   , createSymlink   -- * File renaming/moving   , renameFile   , moveFile+  -- * File reading+  , readFile+  , readFileEOF+  -- * File writing+  , writeFile+  , appendFile   -- * File permissions   , newFilePerms   , newDirPerms@@ -88,10 +95,25 @@   , void   , when   )+import Control.Monad.IfElse+  (+    unlessM+  ) import Data.ByteString   (     ByteString   )+import Data.ByteString.Builder+  (+    Builder+  , byteString+  , toLazyByteString+  )+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Unsafe+  (+    unsafePackCStringFinalizer+  ) import Data.Foldable   (     for_@@ -107,6 +129,10 @@   (     catMaybes   )+import Data.Monoid+  (+    (<>)+  ) import Data.Word   (     Word8@@ -115,9 +141,11 @@   (     eEXIST   , eINVAL+  , eNOENT   , eNOSYS   , eNOTEMPTY   , eXDEV+  , getErrno   ) import Foreign.C.Types   (@@ -138,7 +166,7 @@ import HPath import HPath.Internal import HPath.IO.Errors-import Prelude hiding (readFile)+import Prelude hiding (appendFile, readFile, writeFile) import System.IO.Error   (     catchIOError@@ -219,7 +247,7 @@   --- |The error mode for any recursive operation.+-- |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@@ -227,7 +255,9 @@ -- -- 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.+-- 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 @@ -247,12 +277,13 @@   --- |Copies the contents of a directory recursively to the given destination.--- Does not follow symbolic links. This behaves more or less like:+-- |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: -- -- @---   mkdir \/destination\/dir---   cp -R \/source\/dir\/* \/destination\/dir\/+--   cp -a \/source\/dir \/destination\/somedir -- @ -- -- For directory contents, this will ignore any file type that is not@@ -263,9 +294,6 @@ -- the operation has completed. Permissions of existing directories are -- fixed. ----- Note that there is no guaranteed ordering of the exceptions--- contained within `RecursiveFailure` in `CollectFailures` RecursiveErrorMode.--- -- Safety/reliability concerns: -- --    * not atomic@@ -298,8 +326,8 @@ -- Throws in `Strict` CopyMode only: -- --    - `AlreadyExists` if destination already exists-copyDirRecursive :: Path Abs  -- ^ copy contents of this source dir-                 -> Path Abs  -- ^ to this full destination (parent dirs+copyDirRecursive :: Path Abs  -- ^ source dir+                 -> Path Abs  -- ^ destination (parent dirs                               --   are not automatically created)                  -> CopyMode                  -> RecursiveErrorMode@@ -315,41 +343,56 @@     unless (null collectedExceptions)            (throwIO . RecursiveFailure $ collectedExceptions)   where-    go :: IORef [IOException] -> Path Abs -> Path Abs -> IO ()+    go :: IORef [(RecursiveFailureHint, IOException)]+       -> Path Abs -> Path Abs -> IO ()     go ce fromp' destdirp' = do -      -- order is important here, so we don't get empty directories+      -- NOTE: order is important here, so we don't get empty directories       -- on failure-      contents <- handleIOE ce [] $ do++      -- get the contents of the source dir+      contents <- handleIOE (ReadContentsFailed fromp' destdirp') ce [] $ do         contents <- getDirsFiles fromp' -        fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')-        case cm of-          Strict    -> createDirectory (fromAbs destdirp') fmode'-          Overwrite -> catchIOError (createDirectory (fromAbs destdirp')-                                                     fmode')-                         $ \e ->-                           case ioeGetErrorType e of-                             AlreadyExists -> setFileMode (fromAbs destdirp')-                                                          fmode'-                             _             -> ioError e-        return contents+        -- create the destination dir and+        -- only return contents if we succeed+        handleIOE (CreateDirFailed fromp' destdirp') ce [] $ do+          fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')+          case cm of+            Strict    -> createDirectory (fromAbs destdirp') fmode'+            Overwrite -> catchIOError (createDirectory (fromAbs destdirp')+                                                       fmode')+                           $ \e ->+                             case ioeGetErrorType e of+                               AlreadyExists -> setFileMode (fromAbs destdirp')+                                                            fmode'+                               _             -> ioError e+          return contents -      -- we can't use `easyCopy` here, because we want to call `go`+      -- 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 ce ()+          SymbolicLink -> handleIOE (RecreateSymlinkFailed f newdest) ce ()                             $ recreateSymlink f newdest cm           Directory    -> go ce f newdest-          RegularFile  -> handleIOE ce () $ copyFile f newdest cm+          RegularFile  -> handleIOE (CopyFileFailed f newdest) ce ()+                            $ copyFile f newdest cm           _            -> return ()-    handleIOE :: IORef [IOException] -> a -> IO a -> IO a-    handleIOE ce def = case rm of-      FailEarly -> handleIOError throwIO-      CollectFailures -> handleIOError (\e -> modifyIORef ce (e:)++    -- 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)  @@ -372,7 +415,7 @@ -- -- Throws in `Strict` mode only: -----    - `AlreadyExists` if destination file already exists+--    - `AlreadyExists` if destination already exists -- -- Throws in `Overwrite` mode only: --@@ -505,8 +548,8 @@             if size == 0               then return $ fromIntegral totalsize               else do rsize <- SPB.fdWriteBuf dfd buf size-                      when (rsize /= size) (throwIO . CopyFailed-                                            $ "wrong size!")+                      when (rsize /= size) (ioError $ userError+                                                      "wrong size!")                       write' sfd dfd buf (totalsize + fromIntegral size)  @@ -660,7 +703,9 @@ -- Throws: -- --    - `PermissionDenied` if output directory cannot be written to---    - `AlreadyExists` if destination file already exists+--    - `AlreadyExists` if destination already exists+--    - `NoSuchThing` if any of the parent components of the path+--      do not exist createRegularFile :: FileMode -> Path Abs -> IO () createRegularFile fm dest =   bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just fm)@@ -674,17 +719,50 @@ -- Throws: -- --    - `PermissionDenied` if output directory cannot be written to---    - `AlreadyExists` if destination directory already exists+--    - `AlreadyExists` if destination already exists+--    - `NoSuchThing` if any of the parent components of the path+--      do not exist createDir :: FileMode -> Path Abs -> IO () createDir fm dest = createDirectory (fromAbs dest) fm  +-- |Create an empty directory at the given directory with the given filename.+-- All parent directories are created with the same filemode. This+-- basically behaves like:+--+-- @+--   mkdir -p \/some\/dir+-- @+--+-- Safety/reliability concerns:+--+--    * not atomic+--+-- Throws:+--+--    - `PermissionDenied` if any part of the path components do not+--      exist and cannot be written to+--    - `AlreadyExists` if destination already exists and+--      is not a directory+createDirRecursive :: FileMode -> Path Abs -> IO ()+createDirRecursive fm dest =+  catchIOError (createDirectory (fromAbs dest) fm) $ \e -> do+    errno <- getErrno+    case errno of+         en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e)+            | en == eNOENT -> createDirRecursive fm (dirname dest)+                              >> createDirectory (fromAbs dest) fm+            | otherwise    -> ioError e++ -- |Create a symlink. -- -- Throws: -- --    - `PermissionDenied` if output directory cannot be written to --    - `AlreadyExists` if destination file already exists+--    - `NoSuchThing` if any of the parent components of the path+--      do not exist -- -- Note: calls `symlink` createSymlink :: Path Abs   -- ^ destination file@@ -716,10 +794,7 @@ --     - `PermissionDenied` if source directory cannot be opened --     - `UnsupportedOperation` if source and destination are on different --       devices---     - `FileDoesExist` if destination file already exists---       (`HPathIOException`)---     - `DirDoesExist` if destination directory already exists---       (`HPathIOException`)+--     - `AlreadyExists` if destination already exists --     - `SameFile` if destination and source are the same file --       (`HPathIOException`) --@@ -758,9 +833,7 @@ -- -- Throws in `Strict` mode only: -----    - `FileDoesExist` if destination file already exists (`HPathIOException`)---    - `DirDoesExist` if destination directory already exists---      (`HPathIOException`)+--    - `AlreadyExists` if destination already exists -- -- Note: calls `rename` (but does not allow to rename over existing files) moveFile :: Path Abs  -- ^ file to move@@ -790,6 +863,110 @@       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 Abs -> IO ByteString+readFile p = withAbsPath p $ \fp ->+  bracket (openFd fp SPI.ReadOnly [] Nothing) (SPI.closeFd) $ \fd -> do+    stat <- PF.getFdStatus fd+    let fsize = PF.fileSize stat+    SPB.fdRead fd (fromIntegral fsize)+++-- |Read the given file in chunks of size `8192` into memory until+-- `fread` returns 0. Returns a lazy ByteString, because it uses+-- Builders under the hood.+--+-- 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 Abs -> IO L.ByteString+readFileEOF p = withAbsPath p $ \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)+                                                 mempty+            read' fd buf (builder <> byteString readBS)+++++    --------------------+    --[ File Writing ]--+    --------------------+++-- |Write a given ByteString to a file, truncating the file beforehand.+-- The file must exist. Follows symlinks.+--+-- Throws:+--+--     - `InappropriateType` if file is not a regular file or a symlink+--     - `PermissionDenied` if we cannot read the file or the directory+--        containting it+--     - `NoSuchThing` if the file does not exist+writeFile :: Path Abs -> ByteString -> IO ()+writeFile p bs = withAbsPath p $ \fp ->+  bracket (openFd fp SPI.WriteOnly [SPDF.oTrunc] Nothing) (SPI.closeFd) $ \fd -> +    void $ SPB.fdWrite fd bs+++-- |Append a given ByteString to a file.+-- The file must exist. Follows symlinks.+--+-- Throws:+--+--     - `InappropriateType` if file is not a regular file or a symlink+--     - `PermissionDenied` if we cannot read the file or the directory+--        containting it+--     - `NoSuchThing` if the file does not exist+appendFile :: Path Abs -> ByteString -> IO ()+appendFile p bs = withAbsPath p $ \fp ->+  bracket (openFd fp SPI.WriteOnly [SPDF.oAppend] Nothing)+          (SPI.closeFd) $ \fd -> void $ SPB.fdWrite fd bs   

@@ -16,24 +16,20 @@   (   -- * Types     HPathIOException(..)+  , RecursiveFailureHint(..)    -- * Exception identifiers-  , isFileDoesNotExist-  , isDirDoesNotExist   , isSameFile   , isDestinationInSource-  , isFileDoesExist-  , isDirDoesExist-  , isInvalidOperation-  , isCan'tOpenDirectory-  , isCopyFailed   , isRecursiveFailure+  , isReadContentsFailed+  , isCreateDirFailed+  , isCopyFileFailed+  , isRecreateSymlinkFailed    -- * Path based functions   , throwFileDoesExist   , throwDirDoesExist-  , throwFileDoesNotExist-  , throwDirDoesNotExist   , throwSameFile   , sameFile   , throwDestinationInSource@@ -41,7 +37,6 @@   , doesDirectoryExist   , isWritable   , canOpenDirectory-  , throwCantOpenDirectory    -- * Error handling functions   , catchErrno@@ -63,6 +58,10 @@     forM   , when   )+import Control.Monad.IfElse+  (+    whenM+  ) import Data.ByteString   (     ByteString@@ -72,6 +71,9 @@     toString   ) import Data.Typeable+  (+    Typeable+  ) import Foreign.C.Error   (     getErrno@@ -86,11 +88,12 @@   (     canonicalizePath   )-import HPath.IO.Utils import System.IO.Error   (-    catchIOError+    alreadyExistsErrorType+  , catchIOError   , ioeGetErrorType+  , mkIOError   )  import qualified System.Posix.Directory.ByteString as PFD@@ -102,55 +105,34 @@ import qualified System.Posix.Files.ByteString as PF  -data HPathIOException = FileDoesNotExist ByteString-                      | DirDoesNotExist ByteString-                      | SameFile ByteString ByteString+-- |Additional generic IO exceptions that the posix functions+-- do not provide.+data HPathIOException = SameFile ByteString ByteString                       | DestinationInSource ByteString ByteString-                      | FileDoesExist ByteString-                      | DirDoesExist ByteString-                      | InvalidOperation String-                      | Can'tOpenDirectory ByteString-                      | CopyFailed String-                      | RecursiveFailure [IOException]-  deriving (Typeable, Eq)---instance Show HPathIOException where-  show (FileDoesNotExist fp) = "File does not exist:" ++ toString fp-  show (DirDoesNotExist fp) = "Directory does not exist: "-                              ++ toString fp-  show (SameFile fp1 fp2) = toString fp1-                            ++ " and " ++ toString fp2-                            ++ " are the same file!"-  show (DestinationInSource fp1 fp2) = toString fp1-                                       ++ " is contained in "-                                       ++ toString fp2-  show (FileDoesExist fp) = "File does exist: " ++ toString fp-  show (DirDoesExist fp) = "Directory does exist: " ++ toString fp-  show (InvalidOperation str) = "Invalid operation: " ++ str-  show (Can'tOpenDirectory fp) = "Can't open directory: "-                                 ++ toString fp-  show (CopyFailed str) = "Copying failed: " ++ str-  show (RecursiveFailure exs) = "Recursive operation failed: "-    ++ show exs+                      | RecursiveFailure [(RecursiveFailureHint, IOException)]+  deriving (Eq, Show, Typeable)  -toConstr :: HPathIOException -> String-toConstr FileDoesNotExist {} = "FileDoesNotExist"-toConstr DirDoesNotExist {} = "DirDoesNotExist"-toConstr SameFile {} = "SameFile"-toConstr DestinationInSource {} = "DestinationInSource"-toConstr FileDoesExist {} = "FileDoesExist"-toConstr DirDoesExist {} = "DirDoesExist"-toConstr InvalidOperation {} = "InvalidOperation"-toConstr Can'tOpenDirectory {} = "Can'tOpenDirectory"-toConstr CopyFailed {} = "CopyFailed"-toConstr RecursiveFailure {} = "RecursiveFailure"+-- |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    (Path Abs) (Path Abs)+                          | CreateDirFailed       (Path Abs) (Path Abs)+                          | CopyFileFailed        (Path Abs) (Path Abs)+                          | RecreateSymlinkFailed (Path Abs) (Path Abs)+  deriving (Eq, Show)  +instance Exception HPathIOException  -instance Exception HPathIOException+toConstr :: HPathIOException -> String+toConstr SameFile {}            = "SameFile"+toConstr DestinationInSource {} = "DestinationInSource"+toConstr RecursiveFailure {}    = "RecursiveFailure"   @@ -160,47 +142,54 @@     --[ Exception identifiers ]--     ----------------------------- -isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed, isRecursiveFailure :: HPathIOException -> Bool-isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{}-isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{}++isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{} isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{}-isFileDoesExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesExist{}-isDirDoesExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesExist{}-isInvalidOperation ex = toConstr (ex :: HPathIOException) == toConstr InvalidOperation{}-isCan'tOpenDirectory ex = toConstr (ex :: HPathIOException) == toConstr Can'tOpenDirectory{}-isCopyFailed ex = toConstr (ex :: HPathIOException) == toConstr CopyFailed{} isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{}  +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 Abs -> IO () throwFileDoesExist fp =-  whenM (doesFileExist fp) (throwIO . FileDoesExist-                                    . fromAbs $ fp)+  whenM (doesFileExist fp)+        (ioError . mkIOError+                     alreadyExistsErrorType+                     "File already exists"+                     Nothing+                   $ (Just (toString $ fromAbs fp))+        )  +-- |Throws `AlreadyExists` `IOError` if directory exists. throwDirDoesExist :: Path Abs -> IO () throwDirDoesExist fp =-  whenM (doesDirectoryExist fp) (throwIO . DirDoesExist-                                         . fromAbs $ fp)---throwFileDoesNotExist :: Path Abs -> IO ()-throwFileDoesNotExist fp =-  unlessM (doesFileExist fp) (throwIO . FileDoesNotExist-                                      . fromAbs $ fp)---throwDirDoesNotExist :: Path Abs -> IO ()-throwDirDoesNotExist fp =-  unlessM (doesDirectoryExist fp) (throwIO . DirDoesNotExist-                                           . fromAbs $ fp)+  whenM (doesDirectoryExist fp)+        (ioError . mkIOError+                     alreadyExistsErrorType+                     "Directory already exists"+                     Nothing+                   $ (Just (toString $ fromAbs fp))+        )   -- |Uses `isSameFile` and throws `SameFile` if it returns True.@@ -285,15 +274,8 @@     return True  --- |Throws a `Can'tOpenDirectory` HPathIOException if the directory at the given--- path cannot be opened.-throwCantOpenDirectory :: Path Abs -> IO ()-throwCantOpenDirectory fp =-  unlessM (canOpenDirectory fp)-          (throwIO . Can'tOpenDirectory . fromAbs $ fp)  -     --------------------------------     --[ Error handling functions ]--     --------------------------------@@ -371,3 +353,4 @@                                 else y)                (throwIO ex)                fmios+

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

@@ -157,8 +157,10 @@                         CollectFailures         `shouldThrow`         (\(RecursiveFailure ex@[_, _]) ->-          any (\e -> ioeGetErrorType e == InappropriateType) ex &&-          any (\e -> ioeGetErrorType e == PermissionDenied) 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"@@ -184,7 +186,7 @@                         Strict                         CollectFailures         `shouldThrow`-        (\(RecursiveFailure [e]) -> ioeGetErrorType e == PermissionDenied)+        (\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied)      it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $       copyDirRecursive' "inputDir"@@ -200,7 +202,7 @@                         Strict                         CollectFailures         `shouldThrow`-        (\(RecursiveFailure [e]) -> ioeGetErrorType e == AlreadyExists)+        (\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists)      it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $       copyDirRecursive' "inputDir"@@ -216,7 +218,7 @@                         Strict                         CollectFailures         `shouldThrow`-        (\(RecursiveFailure [e]) -> ioeGetErrorType e == InappropriateType)+        (\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType)      it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $       copyDirRecursive' "wrongInputSymL"@@ -224,7 +226,7 @@                         Strict                         CollectFailures         `shouldThrow`-        (\(RecursiveFailure [e]) -> ioeGetErrorType e == InvalidArgument)+        (\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument)      it "copyDirRecursive (Strict, CollectFailures), destination in source" $       copyDirRecursive' "inputDir"

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

@@ -50,6 +50,11 @@       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`

@@ -48,6 +48,11 @@       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`

@@ -49,6 +49,11 @@       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`

@@ -116,7 +116,7 @@                 "alreadyExistsD"                 Overwrite         `shouldThrow`-        isDirDoesExist+        (\e -> ioeGetErrorType e == AlreadyExists)      it "moveFile (Overwrite), source and dest are same file" $       moveFile' "myFile"

@@ -112,14 +112,14 @@                 "alreadyExists"                 Strict         `shouldThrow`-        isFileDoesExist+        (\e -> ioeGetErrorType e == AlreadyExists)      it "moveFile (Strict), move from file to dir" $       moveFile' "myFile"                 "alreadyExistsD"                 Strict         `shouldThrow`-        isDirDoesExist+        (\e -> ioeGetErrorType e == AlreadyExists)      it "moveFile (Strict), source and dest are same file" $       moveFile' "myFile"

@@ -101,13 +101,13 @@       renameFile' "myFile"                   "alreadyExists"         `shouldThrow`-        isFileDoesExist+        (\e -> ioeGetErrorType e == AlreadyExists)      it "renameFile, move from file to dir" $       renameFile' "myFile"                   "alreadyExistsD"         `shouldThrow`-        isDirDoesExist+        (\e -> ioeGetErrorType e == AlreadyExists)      it "renameFile, source and dest are same file" $       renameFile' "myFile"

@@ -14,6 +14,10 @@     forM_   , void   )+import Control.Monad.IfElse+  (+    whenM+  ) import qualified Data.ByteString as BS import Data.IORef   (@@ -24,7 +28,7 @@   ) import HPath.IO import HPath.IO.Errors-import HPath.IO.Utils+import Prelude hiding (appendFile, readFile, writeFile) import Data.Maybe   (     fromJust@@ -43,6 +47,7 @@   (     ByteString   )+import qualified Data.ByteString.Lazy as L import System.Posix.Files.ByteString   (     groupExecuteMode@@ -179,6 +184,9 @@ {-# NOINLINE createDir' #-} createDir' dest = withTmpDir dest (createDir newDirPerms) +createDirRecursive' :: ByteString -> IO ()+{-# NOINLINE createDirRecursive' #-}+createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms)  createRegularFile' :: ByteString -> IO () {-# NOINLINE createRegularFile' #-}@@ -237,6 +245,12 @@   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@@ -270,15 +284,27 @@ writeFile' :: ByteString -> ByteString -> IO () {-# NOINLINE writeFile' #-} writeFile' ip bs = -  withTmpDir ip $ \p -> do-    fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing-                                   SPI.defaultFileFlags-    _ <- SPB.fdWrite fd bs-    SPI.closeFd fd+  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