hpath 0.7.5 → 0.8.0
raw patch · 26 files changed
+1151/−494 lines, 26 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- HPath.IO: copyDirRecursiveOverwrite :: Path Abs -> Path Abs -> IO ()
- HPath.IO: copyFileOverwrite :: Path Abs -> Path Abs -> IO ()
- HPath.IO: easyCopyOverwrite :: Path Abs -> Path Abs -> IO ()
- HPath.IO: moveFileOverwrite :: Path Abs -> Path Abs -> IO ()
- HPath.IO.Errors: instance Data.Data.Data HPath.IO.Errors.HPathIOException
+ HPath.IO: CollectFailures :: RecursiveErrorMode
+ HPath.IO: FailEarly :: RecursiveErrorMode
+ HPath.IO: Overwrite :: CopyMode
+ HPath.IO: Strict :: CopyMode
+ HPath.IO: data CopyMode
+ HPath.IO: data RecursiveErrorMode
+ HPath.IO.Errors: RecursiveFailure :: [IOException] -> HPathIOException
+ HPath.IO.Errors: isRecursiveFailure :: HPathIOException -> Bool
- HPath.IO: copyDirRecursive :: Path Abs -> Path Abs -> IO ()
+ HPath.IO: copyDirRecursive :: Path Abs -> Path Abs -> CopyMode -> RecursiveErrorMode -> IO ()
- HPath.IO: copyFile :: Path Abs -> Path Abs -> IO ()
+ HPath.IO: copyFile :: Path Abs -> Path Abs -> CopyMode -> IO ()
- HPath.IO: createDir :: Path Abs -> IO ()
+ HPath.IO: createDir :: FileMode -> Path Abs -> IO ()
- HPath.IO: createRegularFile :: Path Abs -> IO ()
+ HPath.IO: createRegularFile :: FileMode -> Path Abs -> IO ()
- HPath.IO: easyCopy :: Path Abs -> Path Abs -> IO ()
+ HPath.IO: easyCopy :: Path Abs -> Path Abs -> CopyMode -> RecursiveErrorMode -> IO ()
- HPath.IO: moveFile :: Path Abs -> Path Abs -> IO ()
+ HPath.IO: moveFile :: Path Abs -> Path Abs -> CopyMode -> IO ()
- HPath.IO: recreateSymlink :: Path Abs -> Path Abs -> IO ()
+ HPath.IO: recreateSymlink :: Path Abs -> Path Abs -> CopyMode -> IO ()
Files
- CHANGELOG +6/−0
- hpath.cabal +7/−2
- src/HPath/IO.hs +215/−212
- src/HPath/IO/Errors.hs +21/−7
- src/System/Posix/Directory/Traversals.hs +5/−1
- test/HPath/IO/CanonicalizePathSpec.hs +6/−3
- test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs +245/−0
- test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs +79/−46
- test/HPath/IO/CopyDirRecursiveSpec.hs +48/−18
- test/HPath/IO/CopyFileOverwriteSpec.hs +52/−33
- test/HPath/IO/CopyFileSpec.hs +34/−16
- test/HPath/IO/CreateDirSpec.hs +7/−3
- test/HPath/IO/CreateRegularFileSpec.hs +7/−5
- test/HPath/IO/CreateSymlinkSpec.hs +7/−4
- test/HPath/IO/DeleteDirRecursiveSpec.hs +8/−3
- test/HPath/IO/DeleteDirSpec.hs +9/−3
- test/HPath/IO/DeleteFileSpec.hs +9/−3
- test/HPath/IO/GetDirsFilesSpec.hs +7/−15
- test/HPath/IO/GetFileTypeSpec.hs +8/−3
- test/HPath/IO/MoveFileOverwriteSpec.hs +55/−38
- test/HPath/IO/MoveFileSpec.hs +31/−15
- test/HPath/IO/RecreateSymlinkOverwriteSpec.hs +139/−0
- test/HPath/IO/RecreateSymlinkSpec.hs +31/−13
- test/HPath/IO/RenameFileSpec.hs +8/−3
- test/Main.hs +2/−6
- test/Utils.hs +105/−42
CHANGELOG view
@@ -1,3 +1,9 @@+0.8.0+ * 'copyDirRecursiveOverwrite', 'copyFileOverwrite', 'easyCopyOverwrite' and 'moveFileOverwrite' have been removed, instead use the versions without the *Overwrite suffix and pass in 'Strict' (for default behavior) or 'Overwrite' as the CopyMode argument+ * introduced a new 'RecursiveErrorMode' type to allow controlling recursive behavior of 'copyDirRecursive' (use 'FailEarly' for default behavior)+ * 'createRegularFile' and 'createDir' now take FileMode as a parameter (also see 'newFilePerms' and 'newDirPerms')+ * various documentation fixes+ * improved reliability of tests 0.7.5: * relicense to BSD3 0.7.3:
hpath.cabal view
@@ -1,5 +1,5 @@ name: hpath-version: 0.7.5+version: 0.8.0 synopsis: Support for well-typed paths description: Support for well-typed paths, utilizing ByteString under the hood. license: BSD3@@ -19,7 +19,10 @@ library hs-source-dirs: src/ default-language: Haskell2010- ghc-options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wall -Wno-redundant-constraints+ else+ ghc-options: -Wall c-sources: cbits/dirutils.c exposed-modules: HPath, HPath.IO,@@ -73,6 +76,7 @@ Main-Is: Main.hs other-modules: HPath.IO.CanonicalizePathSpec+ HPath.IO.CopyDirRecursiveCollectFailuresSpec HPath.IO.CopyDirRecursiveOverwriteSpec HPath.IO.CopyDirRecursiveSpec HPath.IO.CopyFileOverwriteSpec@@ -87,6 +91,7 @@ HPath.IO.GetFileTypeSpec HPath.IO.MoveFileOverwriteSpec HPath.IO.MoveFileSpec+ HPath.IO.RecreateSymlinkOverwriteSpec HPath.IO.RecreateSymlinkSpec HPath.IO.RenameFileSpec Spec
src/HPath/IO.hs view
@@ -37,14 +37,13 @@ ( -- * Types FileType(..)+ , RecursiveErrorMode(..)+ , CopyMode(..) -- * File copying , copyDirRecursive- , copyDirRecursiveOverwrite , recreateSymlink , copyFile- , copyFileOverwrite , easyCopy- , easyCopyOverwrite -- * File deletion , deleteFile , deleteDir@@ -60,7 +59,6 @@ -- * File renaming/moving , renameFile , moveFile- , moveFileOverwrite -- * File permissions , newFilePerms , newDirPerms@@ -80,12 +78,14 @@ ) import Control.Exception (- bracket+ IOException+ , bracket , throwIO ) import Control.Monad (- void+ unless+ , void , when ) import Data.ByteString@@ -96,6 +96,13 @@ ( for_ )+import Data.IORef+ (+ IORef+ , modifyIORef+ , newIORef+ , readIORef+ ) import Data.Maybe ( catMaybes@@ -131,7 +138,6 @@ import HPath import HPath.Internal import HPath.IO.Errors-import HPath.IO.Utils import Prelude hiding (readFile) import System.IO.Error (@@ -213,21 +219,53 @@ +-- |The error mode for any recursive operation.+--+-- On `FailEarly` the whole operation fails immediately if any of the+-- recursive sub-operations fail, which is sort of the default+-- for IO operations.+--+-- On `CollectFailures` skips errors in the recursion and keeps on recursing.+-- However all errors are collected in the `RecursiveFailure` error type,+-- which is raised finally if there was any error.+data RecursiveErrorMode = FailEarly+ | CollectFailures +-- |The mode for copy and file moves.+-- Overwrite mode is usually not very well defined, but is a convenience+-- shortcut.+data CopyMode = Strict -- ^ fail if any target exists+ | Overwrite -- ^ overwrite targets++++ -------------------- --[ File Copying ]-- -------------------- --- |Copies a directory recursively to the given destination.--- Does not follow symbolic links.+-- |Copies the contents of a directory recursively to the given destination.+-- Does not follow symbolic links. This behaves more or less like: ----- For directory contents, this has the same behavior as `easyCopy`--- and thus will ignore any file type that is not `RegularFile`,--- `SymbolicLink` or `Directory`.+-- @+-- mkdir \/destination\/dir+-- cp -R \/source\/dir\/* \/destination\/dir\/+-- @ --+-- For directory contents, this will ignore any file type that is not+-- `RegularFile`, `SymbolicLink` or `Directory`.+--+-- For `Overwrite` copy mode this does not prune destination directory+-- contents, so the destination might contain more files than the source after+-- the operation has completed. Permissions of existing directories are+-- fixed.+--+-- Note that there is no guaranteed ordering of the exceptions+-- contained within `RecursiveFailure` in `CollectFailures` RecursiveErrorMode.+-- -- Safety/reliability concerns: -- -- * not atomic@@ -240,31 +278,62 @@ -- Throws: -- -- - `NoSuchThing` if source directory does not exist--- - `PermissionDenied` if output directory is not writable -- - `PermissionDenied` if source directory can't be opened+-- - `SameFile` if source and destination are the same file+-- (`HPathIOException`)+-- - `DestinationInSource` if destination is contained in source+-- (`HPathIOException`)+--+-- Throws in `FailEarly` RecursiveErrorMode only:+--+-- - `PermissionDenied` if output directory is not writable -- - `InvalidArgument` if source directory is wrong type (symlink)--- - `InvalidArgument` if source directory is wrong type (regular file)+-- - `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--- - `SameFile` if source and destination are the same file (`HPathIOException`)--- - `DestinationInSource` if destination is contained in source (`HPathIOException`)-copyDirRecursive :: Path Abs -- ^ source dir- -> Path Abs -- ^ full destination+copyDirRecursive :: Path Abs -- ^ copy contents of this source dir+ -> Path Abs -- ^ to this full destination (parent dirs+ -- are not automatically created)+ -> CopyMode+ -> RecursiveErrorMode -> IO ()-copyDirRecursive fromp destdirp+copyDirRecursive fromp destdirp cm rm = do+ ce <- newIORef [] -- for performance, sanity checks are only done for the top dir throwSameFile fromp destdirp throwDestinationInSource fromp destdirp- go fromp destdirp+ go ce fromp destdirp+ collectedExceptions <- readIORef ce+ unless (null collectedExceptions)+ (throwIO . RecursiveFailure $ collectedExceptions) where- go :: Path Abs -> Path Abs -> IO ()- go fromp' destdirp' = do+ go :: IORef [IOException] -> Path Abs -> Path Abs -> IO ()+ go ce fromp' destdirp' = do+ -- order is important here, so we don't get empty directories -- on failure- contents <- getDirsFiles fromp'+ contents <- handleIOE ce [] $ do+ contents <- getDirsFiles fromp' - fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')- createDirectory (fromAbs destdirp') fmode'+ fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')+ case cm of+ Strict -> createDirectory (fromAbs destdirp') fmode'+ Overwrite -> catchIOError (createDirectory (fromAbs destdirp')+ fmode')+ $ \e ->+ case ioeGetErrorType e of+ AlreadyExists -> setFileMode (fromAbs destdirp')+ fmode'+ _ -> ioError e+ return contents -- we can't use `easyCopy` here, because we want to call `go` -- recursively to skip the top-level sanity checks@@ -272,81 +341,60 @@ ftype <- getFileType f newdest <- (destdirp' </>) <$> basename f case ftype of- SymbolicLink -> recreateSymlink f newdest- Directory -> go f newdest- RegularFile -> copyFile f newdest+ SymbolicLink -> handleIOE ce ()+ $ recreateSymlink f newdest cm+ Directory -> go ce f newdest+ RegularFile -> handleIOE ce () $ copyFile f newdest cm _ -> return ()+ handleIOE :: IORef [IOException] -> a -> IO a -> IO a+ handleIOE ce def = case rm of+ FailEarly -> handleIOError throwIO+ CollectFailures -> handleIOError (\e -> modifyIORef ce (e:)+ >> return def) --- |Like `copyDirRecursive` except it overwrites contents of directories--- if any.+-- |Recreate a symlink. ----- For directory contents, this has the same behavior as `easyCopyOverwrite`--- and thus will ignore any file type that is not `RegularFile`,--- `SymbolicLink` or `Directory`.+-- In `Overwrite` copy mode only files and empty directories are deleted. ----- Throws:+-- Safety/reliability concerns: ----- - `NoSuchThing` if source directory does not exist--- - `PermissionDenied` if output directory is not writable--- - `PermissionDenied` if source directory can't be opened--- - `InvalidArgument` if source directory is wrong type (symlink)--- - `InvalidArgument` if source directory is wrong type (regular file)--- - `SameFile` if source and destination are the same file (`HPathIOException`)--- - `DestinationInSource` if destination is contained in source (`HPathIOException`)-copyDirRecursiveOverwrite :: Path Abs -- ^ source dir- -> Path Abs -- ^ full destination- -> IO ()-copyDirRecursiveOverwrite fromp destdirp- = do- -- for performance, sanity checks are only done for the top dir- throwSameFile fromp destdirp- throwDestinationInSource fromp destdirp- go fromp destdirp- where- go :: Path Abs -> Path Abs -> IO ()- go fromp' destdirp' = do- -- order is important here, so we don't get empty directories- -- on failure- contents <- getDirsFiles fromp'-- fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')- catchIOError (createDirectory (fromAbs destdirp') fmode') $ \e ->- case ioeGetErrorType e of- AlreadyExists -> setFileMode (fromAbs destdirp') fmode'- _ -> ioError e-- -- we can't use `easyCopyOverwrite` here, because we want to call `go`- -- recursively to skip the top-level sanity checks- for_ contents $ \f -> do- ftype <- getFileType f- newdest <- (destdirp' </>) <$> basename f- case ftype of- SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest)- >> recreateSymlink f newdest- Directory -> go f newdest- RegularFile -> copyFileOverwrite f newdest- _ -> return ()----- |Recreate a symlink.+-- * `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 file already exists--- - `SameFile` if source and destination are the same file (`HPathIOException`) --+-- Throws in `Overwrite` mode only:+--+-- - `UnsatisfiedConstraints` if destination file is non-empty directory+-- -- Note: calls `symlink` recreateSymlink :: Path Abs -- ^ the old symlink file -> Path Abs -- ^ destination file+ -> CopyMode -> IO ()-recreateSymlink symsource newsym+recreateSymlink symsource newsym cm = do throwSameFile symsource newsym sympoint <- readSymbolicLink (fromAbs symsource)+ case cm of+ Strict -> return ()+ Overwrite -> do+ writable <- isWritable (dirname newsym)+ isfile <- doesFileExist newsym+ isdir <- doesDirectoryExist newsym+ when (writable && isfile) (deleteFile newsym)+ when (writable && isdir) (deleteDir newsym) createSymbolicLink sympoint (fromAbs newsym) @@ -358,8 +406,11 @@ -- examine file types. For a more high-level version, use `easyCopy` -- instead. --+-- In `Overwrite` copy mode only overwrites actual files, not directories.+-- -- 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"@@ -374,61 +425,39 @@ -- - `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--- - `SameFile` if source and destination are the same file (`HPathIOException`) -- -- Note: calls `sendfile` and possibly `read`/`write` as fallback copyFile :: Path Abs -- ^ source file -> Path Abs -- ^ destination file+ -> CopyMode -> IO ()-copyFile from to = do- throwSameFile from to- _copyFile [SPDF.oNofollow]- [SPDF.oNofollow, SPDF.oExcl]- from to----- |Like `copyFile` except it overwrites the destination if it already--- exists.------ Safety/reliability concerns:------ * 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--- * not atomic, since it uses read/write------ Throws:------ - `NoSuchThing` if source file does not exist--- - `NoSuchThing` if source file is 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`)------ Note: calls `sendfile` and possibly `read`/`write` as fallback-copyFileOverwrite :: Path Abs -- ^ source file- -> Path Abs -- ^ destination file- -> IO ()-copyFileOverwrite from to = do+copyFile from to cm = do throwSameFile from to- catchIOError (_copyFile [SPDF.oNofollow]- [SPDF.oNofollow, SPDF.oTrunc]- from to) $ \e ->- case ioeGetErrorType e of- -- if the destination file is not writable, we need to- -- figure out if we can still copy by deleting it first- PermissionDenied -> do- exists <- doesFileExist to- writable <- isWritable (dirname to)- if exists && writable- then deleteFile to >> copyFile from to- else ioError e- _ -> ioError e+ + case cm of+ Strict -> _copyFile [SPDF.oNofollow]+ [SPDF.oNofollow, SPDF.oExcl]+ from to+ Overwrite -> + catchIOError (_copyFile [SPDF.oNofollow]+ [SPDF.oNofollow, SPDF.oTrunc]+ from to) $ \e ->+ case ioeGetErrorType e of+ -- if the destination file is not writable, we need to+ -- figure out if we can still copy by deleting it first+ PermissionDenied -> do+ exists <- doesFileExist to+ writable <- isWritable (dirname to)+ if exists && writable+ then deleteFile to >> copyFile from to Strict+ else ioError e+ _ -> ioError e _copyFile :: [SPDF.Flags]@@ -439,8 +468,8 @@ _copyFile sflags dflags from to = -- from sendfile(2) manpage:- -- Applications may wish to fall back to read(2)/write(2) in the case- -- where sendfile() fails with EINVAL or ENOSYS.+ -- Applications may wish to fall back to read(2)/write(2) in+ -- the case where sendfile() fails with EINVAL or ENOSYS. withAbsPath to $ \to' -> withAbsPath from $ \from' -> catchErrno [eINVAL, eNOSYS] (sendFileCopy from' to')@@ -476,7 +505,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) (throwIO . CopyFailed+ $ "wrong size!") write' sfd dfd buf (totalsize + fromIntegral size) @@ -490,41 +520,21 @@ -- * calls `copyDirRecursive` for directories easyCopy :: Path Abs -> Path Abs+ -> CopyMode+ -> RecursiveErrorMode -> IO ()-easyCopy from to = do- ftype <- getFileType from- case ftype of- SymbolicLink -> recreateSymlink from to- RegularFile -> copyFile from to- Directory -> copyDirRecursive from to- _ -> return ()----- |Like `easyCopy` except it overwrites the destination if it already exists.--- For directories, this overwrites contents without pruning them, so the resulting--- directory may have more files than have been copied.------ Safety/reliability concerns:------ * examines filetypes explicitly--- * calls `copyDirRecursive` for directories-easyCopyOverwrite :: Path Abs- -> Path Abs- -> IO ()-easyCopyOverwrite from to = do+easyCopy from to cm rm = do ftype <- getFileType from case ftype of- SymbolicLink -> whenM (doesFileExist to) (deleteFile to)- >> recreateSymlink from to- RegularFile -> copyFileOverwrite from to- Directory -> copyDirRecursiveOverwrite from to+ SymbolicLink -> recreateSymlink from to cm+ RegularFile -> copyFile from to cm+ Directory -> copyDirRecursive from to cm rm _ -> return () - --------------------- --[ File Deletion ]-- ---------------------@@ -644,15 +654,16 @@ --------------------- --- |Create an empty regular file at the given directory with the given filename.+-- |Create an empty regular file at the given directory with the given+-- filename. -- -- Throws: -- -- - `PermissionDenied` if output directory cannot be written to -- - `AlreadyExists` if destination file already exists-createRegularFile :: Path Abs -> IO ()-createRegularFile dest =- bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just newFilePerms)+createRegularFile :: FileMode -> Path Abs -> IO ()+createRegularFile fm dest =+ bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just fm) (SPI.defaultFileFlags { exclusive = True })) SPI.closeFd (\_ -> return ())@@ -664,8 +675,8 @@ -- -- - `PermissionDenied` if output directory cannot be written to -- - `AlreadyExists` if destination directory already exists-createDir :: Path Abs -> IO ()-createDir dest = createDirectory (fromAbs dest) newDirPerms+createDir :: FileMode -> Path Abs -> IO ()+createDir fm dest = createDirectory (fromAbs dest) fm -- |Create a symlink.@@ -703,10 +714,14 @@ -- - `NoSuchThing` if source file does not exist -- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if source directory cannot be opened--- - `UnsupportedOperation` if source and destination are on different devices--- - `FileDoesExist` if destination file already exists (`HPathIOException`)--- - `DirDoesExist` if destination directory already exists (`HPathIOException`)--- - `SameFile` if destination and source are the same file (`HPathIOException`)+-- - `UnsupportedOperation` if source and destination are on different+-- devices+-- - `FileDoesExist` if destination file already exists+-- (`HPathIOException`)+-- - `DirDoesExist` if destination directory already exists+-- (`HPathIOException`)+-- - `SameFile` if destination and source are the same file+-- (`HPathIOException`) -- -- Note: calls `rename` (but does not allow to rename over existing files) renameFile :: Path Abs -> Path Abs -> IO ()@@ -725,70 +740,56 @@ -- -- Safety/reliability concerns: --+-- * `Overwrite` mode is not atomic -- * copy-delete fallback is inherently non-atomic -- * since this function calls `easyCopy` and `easyDelete` as a fallback -- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink` -- or `Directory` may be ignored+-- * for `Overwrite` mode, the destination will be deleted (not recursively)+-- before moving -- -- Throws: -- -- - `NoSuchThing` if source file does not exist -- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if source directory cannot be opened--- - `FileDoesExist` if destination file already exists (`HPathIOException`)--- - `DirDoesExist` if destination directory already exists (`HPathIOException`)--- - `SameFile` if destination and source are the same file (`HPathIOException`)+-- - `SameFile` if destination and source are the same file+-- (`HPathIOException`) --+-- Throws in `Strict` mode only:+--+-- - `FileDoesExist` if destination file already exists (`HPathIOException`)+-- - `DirDoesExist` if destination directory already exists+-- (`HPathIOException`)+-- -- Note: calls `rename` (but does not allow to rename over existing files) moveFile :: Path Abs -- ^ file to move -> Path Abs -- ^ destination+ -> CopyMode -> IO ()-moveFile from to = do+moveFile from to cm = do throwSameFile from to- catchErrno [eXDEV] (renameFile from to) $ do- easyCopy from to- easyDelete from+ case cm of+ Strict -> catchErrno [eXDEV] (renameFile from to) $ do+ easyCopy from to Strict FailEarly+ easyDelete from+ Overwrite -> do+ ft <- getFileType from+ writable <- isWritable $ dirname to+ case ft of+ RegularFile -> do+ exists <- doesFileExist to+ when (exists && writable) (deleteFile to)+ SymbolicLink -> do+ exists <- doesFileExist to+ when (exists && writable) (deleteFile to)+ Directory -> do+ exists <- doesDirectoryExist to+ when (exists && writable) (deleteDir to)+ _ -> return ()+ moveFile from to Strict --- |Like `moveFile`, but overwrites the destination if it exists.------ Does not follow symbolic links, but renames the symbolic link file.------ Ignores any file type that is not `RegularFile`, `SymbolicLink` or--- `Directory`.------ Safety/reliability concerns:------ * copy-delete fallback is inherently non-atomic--- * checks for file types and destination file existence explicitly------ Throws:------ - `NoSuchThing` if source file does not exist--- - `PermissionDenied` if output directory cannot be written to--- - `PermissionDenied` if source directory cannot be opened--- - `SameFile` if destination and source are the same file (`HPathIOException`)------ Note: calls `rename` (but does not allow to rename over existing files)-moveFileOverwrite :: Path Abs -- ^ file to move- -> Path Abs -- ^ destination- -> IO ()-moveFileOverwrite from to = do- throwSameFile from to- ft <- getFileType from- writable <- isWritable $ dirname to- case ft of- RegularFile -> do- exists <- doesFileExist to- when (exists && writable) (deleteFile to)- SymbolicLink -> do- exists <- doesFileExist to- when (exists && writable) (deleteFile to)- Directory -> do- exists <- doesDirectoryExist to- when (exists && writable) (deleteDir to)- _ -> return ()- moveFile from to @@ -827,6 +828,8 @@ -- |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: --
src/HPath/IO/Errors.hs view
@@ -27,6 +27,7 @@ , isInvalidOperation , isCan'tOpenDirectory , isCopyFailed+ , isRecursiveFailure -- * Path based functions , throwFileDoesExist@@ -70,10 +71,6 @@ ( toString )-import Data.Data- (- Data(..)- ) import Data.Typeable import Foreign.C.Error (@@ -114,7 +111,8 @@ | InvalidOperation String | Can'tOpenDirectory ByteString | CopyFailed String- deriving (Typeable, Eq, Data)+ | RecursiveFailure [IOException]+ deriving (Typeable, Eq) instance Show HPathIOException where@@ -133,9 +131,25 @@ show (Can'tOpenDirectory fp) = "Can't open directory: " ++ toString fp show (CopyFailed str) = "Copying failed: " ++ str+ show (RecursiveFailure exs) = "Recursive operation failed: "+ ++ show exs +toConstr :: HPathIOException -> String+toConstr FileDoesNotExist {} = "FileDoesNotExist"+toConstr DirDoesNotExist {} = "DirDoesNotExist"+toConstr SameFile {} = "SameFile"+toConstr DestinationInSource {} = "DestinationInSource"+toConstr FileDoesExist {} = "FileDoesExist"+toConstr DirDoesExist {} = "DirDoesExist"+toConstr InvalidOperation {} = "InvalidOperation"+toConstr Can'tOpenDirectory {} = "Can'tOpenDirectory"+toConstr CopyFailed {} = "CopyFailed"+toConstr RecursiveFailure {} = "RecursiveFailure" +++ instance Exception HPathIOException @@ -146,7 +160,7 @@ --[ Exception identifiers ]-- ----------------------------- -isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed :: HPathIOException -> Bool+isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed, isRecursiveFailure :: HPathIOException -> Bool isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{} isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{} isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{}@@ -156,7 +170,7 @@ 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{}
src/System/Posix/Directory/Traversals.hs view
@@ -10,6 +10,7 @@ -- Traversal and read operations on directories. +{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-}@@ -37,7 +38,10 @@ , realpath ) where -import Control.Applicative++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif import Control.Monad import System.Posix.FilePath ((</>)) import System.Posix.Directory.Foreign
test/HPath/IO/CanonicalizePathSpec.hs view
@@ -13,12 +13,15 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) +upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CanonicalizePathSpec"+ createTmpDir+ setupFiles :: IO () setupFiles = do createRegularFile' "file"@@ -37,7 +40,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.canonicalizePath" $ do -- successes --
+ test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE OverloadedStrings #-}+++module HPath.IO.CopyDirRecursiveCollectFailuresSpec where+++import Test.Hspec+import Data.List (sort)+import HPath.IO+import HPath.IO.Errors+import System.IO.Error+ (+ ioeGetErrorType+ )+import GHC.IO.Exception+ (+ IOErrorType(..)+ )+import System.Exit+import System.Process+import Utils+import qualified Data.ByteString as BS+import Data.ByteString.UTF8 (toString)++++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CopyDirRecursiveCollectFailuresSpec"+ createTmpDir++setupFiles :: IO ()+setupFiles = do+ createRegularFile' "alreadyExists"+ createRegularFile' "wrongInput"+ createSymlink' "wrongInputSymL" "inputDir/"+ createDir' "alreadyExistsD"+ createDir' "noPerms"+ createDir' "noWritePerm"++ createDir' "inputDir"+ createDir' "inputDir/bar"+ createDir' "inputDir/foo"+ createRegularFile' "inputDir/foo/inputFile1"+ createRegularFile' "inputDir/inputFile2"+ createRegularFile' "inputDir/bar/inputFile3"+ writeFile' "inputDir/foo/inputFile1" "SDAADSdsada"+ writeFile' "inputDir/inputFile2" "Blahfaselgagaga"+ writeFile' "inputDir/bar/inputFile3"+ "fdfdssdffsd3223sasdasdasdadasasddasdasdasasd4"++ createDir' "inputDir1"+ createDir' "inputDir1/foo2"+ createDir' "inputDir1/foo2/foo3"+ createDir' "inputDir1/foo2/foo4"+ createRegularFile' "inputDir1/foo2/inputFile1"+ createRegularFile' "inputDir1/foo2/inputFile2"+ createRegularFile' "inputDir1/foo2/inputFile3"+ createRegularFile' "inputDir1/foo2/foo4/inputFile4"+ createRegularFile' "inputDir1/foo2/foo4/inputFile6"+ createRegularFile' "inputDir1/foo2/foo3/inputFile5"+ noPerms "inputDir1/foo2/foo3"++ createDir' "outputDir1"+ createDir' "outputDir1/foo2"+ createDir' "outputDir1/foo2/foo4"+ createDir' "outputDir1/foo2/foo4/inputFile4"+ createRegularFile' "outputDir1/foo2/foo4/inputFile6"+ noPerms "outputDir1/foo2/foo4/inputFile4"+ noPerms "outputDir1/foo2/foo4"++ noPerms "noPerms"+ noWritableDirPerms "noWritePerm"+++cleanupFiles :: IO ()+cleanupFiles = do+ normalDirPerms "noPerms"+ normalDirPerms "noWritePerm"++ normalDirPerms "inputDir1/foo2/foo3"+ deleteFile' "inputDir1/foo2/foo4/inputFile4"+ deleteFile' "inputDir1/foo2/foo4/inputFile6"+ deleteFile' "inputDir1/foo2/inputFile1"+ deleteFile' "inputDir1/foo2/inputFile2"+ deleteFile' "inputDir1/foo2/inputFile3"+ deleteFile' "inputDir1/foo2/foo3/inputFile5"+ deleteDir' "inputDir1/foo2/foo3"+ deleteDir' "inputDir1/foo2/foo4"+ deleteDir' "inputDir1/foo2"+ deleteDir' "inputDir1"++ normalDirPerms "outputDir1/foo2/foo4"+ normalDirPerms "outputDir1/foo2/foo4/inputFile4"+ deleteFile' "outputDir1/foo2/foo4/inputFile6"+ deleteDir' "outputDir1/foo2/foo4/inputFile4"+ deleteDir' "outputDir1/foo2/foo4"+ deleteDir' "outputDir1/foo2"+ deleteDir' "outputDir1"++ deleteFile' "alreadyExists"+ deleteFile' "wrongInput"+ deleteFile' "wrongInputSymL"+ deleteDir' "alreadyExistsD"+ deleteDir' "noPerms"+ deleteDir' "noWritePerm"+ deleteFile' "inputDir/foo/inputFile1"+ deleteFile' "inputDir/inputFile2"+ deleteFile' "inputDir/bar/inputFile3"+ deleteDir' "inputDir/foo"+ deleteDir' "inputDir/bar"+ deleteDir' "inputDir"+++++spec :: Spec+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+ describe "HPath.IO.copyDirRecursive" $ do++ -- successes --+ it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do+ tmpDir' <- getRawTmpDir+ copyDirRecursive' "inputDir"+ "outputDir"+ Strict+ CollectFailures+ (system $ "diff -r --no-dereference "+ ++ toString tmpDir' ++ "inputDir" ++ " "+ ++ toString tmpDir' ++ "outputDir")+ `shouldReturn` ExitSuccess+ removeDirIfExists "outputDir"++ -- posix failures --+ it "copyDirRecursive (Strict, CollectFailures), source directory does not exist" $+ copyDirRecursive' "doesNotExist"+ "outputDir"+ Strict+ CollectFailures+ `shouldThrow`+ (\e -> ioeGetErrorType e == NoSuchThing)++ it "copyDirRecursive (Strict, CollectFailures), cannot open source dir" $+ copyDirRecursive' "noPerms/inputDir"+ "foo"+ Strict+ CollectFailures+ `shouldThrow`+ (\e -> ioeGetErrorType e == PermissionDenied)+++ -- custom failures+ it "copyDirRecursive (Overwrite, CollectFailures), various failures" $ do+ copyDirRecursive' "inputDir1/foo2"+ "outputDir1/foo2"+ Overwrite+ CollectFailures+ `shouldThrow`+ (\(RecursiveFailure ex@[_, _]) ->+ any (\e -> ioeGetErrorType e == InappropriateType) ex &&+ any (\e -> ioeGetErrorType e == PermissionDenied) ex)+ normalDirPerms "outputDir1/foo2/foo4"+ normalDirPerms "outputDir1/foo2/foo4/inputFile4"+ c <- allDirectoryContents' "outputDir1"+ tmpDir' <- getRawTmpDir+ let shouldC = (fmap (\x -> tmpDir' `BS.append` x)+ ["outputDir1"+ ,"outputDir1/foo2"+ ,"outputDir1/foo2/inputFile1"+ ,"outputDir1/foo2/inputFile2"+ ,"outputDir1/foo2/inputFile3"+ ,"outputDir1/foo2/foo4"+ ,"outputDir1/foo2/foo4/inputFile6"+ ,"outputDir1/foo2/foo4/inputFile4"])+ deleteFile' "outputDir1/foo2/inputFile1"+ deleteFile' "outputDir1/foo2/inputFile2"+ deleteFile' "outputDir1/foo2/inputFile3"+ sort c `shouldBe` sort shouldC+++ it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $+ copyDirRecursive' "inputDir"+ "noWritePerm/foo"+ Strict+ CollectFailures+ `shouldThrow`+ (\(RecursiveFailure [e]) -> ioeGetErrorType e == PermissionDenied)++ it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $+ copyDirRecursive' "inputDir"+ "noPerms/foo"+ Strict+ CollectFailures+ `shouldThrow`+ isRecursiveFailure++ it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $+ copyDirRecursive' "inputDir"+ "alreadyExistsD"+ Strict+ CollectFailures+ `shouldThrow`+ (\(RecursiveFailure [e]) -> ioeGetErrorType e == AlreadyExists)++ it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $+ copyDirRecursive' "inputDir"+ "alreadyExists"+ Strict+ CollectFailures+ `shouldThrow`+ isRecursiveFailure++ it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $+ copyDirRecursive' "wrongInput"+ "outputDir"+ Strict+ CollectFailures+ `shouldThrow`+ (\(RecursiveFailure [e]) -> ioeGetErrorType e == InappropriateType)++ it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $+ copyDirRecursive' "wrongInputSymL"+ "outputDir"+ Strict+ CollectFailures+ `shouldThrow`+ (\(RecursiveFailure [e]) -> ioeGetErrorType e == InvalidArgument)++ it "copyDirRecursive (Strict, CollectFailures), destination in source" $+ copyDirRecursive' "inputDir"+ "inputDir/foo"+ Strict+ CollectFailures+ `shouldThrow`+ isDestinationInSource++ it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $+ copyDirRecursive' "inputDir"+ "inputDir"+ Strict+ CollectFailures+ `shouldThrow`+ isSameFile++
test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs view
@@ -5,6 +5,7 @@ import Test.Hspec+import HPath.IO import HPath.IO.Errors import System.IO.Error (@@ -17,11 +18,16 @@ import System.Exit import System.Process import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString)+import Data.ByteString.UTF8 (toString) +upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CopyDirRecursiveOverwriteSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists"@@ -81,89 +87,116 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $- describe "HPath.IO.copyDirRecursiveOverwrite" $ do+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+ describe "HPath.IO.copyDirRecursive" $ do -- successes --- it "copyDirRecursiveOverwrite, all fine" $ do- copyDirRecursiveOverwrite' "inputDir"- "outputDir"+ it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do+ copyDirRecursive' "inputDir"+ "outputDir"+ Overwrite+ FailEarly removeDirIfExists "outputDir" - it "copyDirRecursiveOverwrite, all fine and compare" $ do- copyDirRecursiveOverwrite' "inputDir"- "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")+ ++ toString tmpDir' ++ "inputDir" ++ " "+ ++ toString tmpDir' ++ "outputDir") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" - it "copyDirRecursiveOverwrite, destination dir already exists" $ do+ it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do+ tmpDir' <- getRawTmpDir (system $ "diff -r --no-dereference "- ++ toString tmpDir ++ "inputDir" ++ " "- ++ toString tmpDir ++ "alreadyExistsD")+ ++ toString tmpDir' ++ "inputDir" ++ " "+ ++ toString tmpDir' ++ "alreadyExistsD") `shouldReturn` (ExitFailure 1)- copyDirRecursiveOverwrite' "inputDir"- "alreadyExistsD"+ copyDirRecursive' "inputDir"+ "alreadyExistsD"+ Overwrite+ FailEarly (system $ "diff -r --no-dereference "- ++ toString tmpDir ++ "inputDir" ++ " "- ++ toString tmpDir ++ "alreadyExistsD")+ ++ toString tmpDir' ++ "inputDir" ++ " "+ ++ toString tmpDir' ++ "alreadyExistsD") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" + -- posix failures --- it "copyDirRecursiveOverwrite, source directory does not exist" $- copyDirRecursiveOverwrite' "doesNotExist"- "outputDir"+ it "copyDirRecursive, source directory does not exist" $+ copyDirRecursive' "doesNotExist"+ "outputDir"+ Overwrite+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "copyDirRecursiveOverwrite, no write permission on output dir" $- copyDirRecursiveOverwrite' "inputDir"- "noWritePerm/foo"+ it "copyDirRecursive, no write permission on output dir" $+ copyDirRecursive' "inputDir"+ "noWritePerm/foo"+ Overwrite+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursiveOverwrite, cannot open output dir" $- copyDirRecursiveOverwrite' "inputDir"- "noPerms/foo"+ it "copyDirRecursive, cannot open output dir" $+ copyDirRecursive' "inputDir"+ "noPerms/foo"+ Overwrite+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursiveOverwrite, cannot open source dir" $- copyDirRecursiveOverwrite' "noPerms/inputDir"- "foo"+ it "copyDirRecursive, cannot open source dir" $+ copyDirRecursive' "noPerms/inputDir"+ "foo"+ Overwrite+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursiveOverwrite, destination already exists and is a file" $- copyDirRecursiveOverwrite' "inputDir"- "alreadyExists"+ it "copyDirRecursive, destination already exists and is a file" $+ copyDirRecursive' "inputDir"+ "alreadyExists"+ Overwrite+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyDirRecursiveOverwrite, wrong input (regular file)" $- copyDirRecursiveOverwrite' "wrongInput"- "outputDir"+ it "copyDirRecursive, wrong input (regular file)" $+ copyDirRecursive' "wrongInput"+ "outputDir"+ Overwrite+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $- copyDirRecursiveOverwrite' "wrongInputSymL"- "outputDir"+ it "copyDirRecursive, wrong input (symlink to directory)" $+ copyDirRecursive' "wrongInputSymL"+ "outputDir"+ Overwrite+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) -- custom failures- it "copyDirRecursiveOverwrite, destination in source" $- copyDirRecursiveOverwrite' "inputDir"- "inputDir/foo"+ it "copyDirRecursive (Overwrite, FailEarly), destination in source" $+ copyDirRecursive' "inputDir"+ "inputDir/foo"+ Overwrite+ FailEarly `shouldThrow` isDestinationInSource - it "copyDirRecursiveOverwrite, destination and source same directory" $- copyDirRecursiveOverwrite' "inputDir"- "inputDir"+ it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $+ copyDirRecursive' "inputDir"+ "inputDir"+ Overwrite+ FailEarly `shouldThrow` isSameFile
test/HPath/IO/CopyDirRecursiveSpec.hs view
@@ -5,6 +5,7 @@ import Test.Hspec+import HPath.IO import HPath.IO.Errors import System.IO.Error (@@ -17,12 +18,14 @@ import System.Exit import System.Process import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString)-+import Data.ByteString.UTF8 (toString) +upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CopyDirRecursiveSpec"+ createTmpDir setupFiles :: IO () setupFiles = do@@ -69,82 +72,109 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.copyDirRecursive" $ do -- successes --- it "copyDirRecursive, all fine" $ do+ it "copyDirRecursive (Strict, FailEarly), all fine" $ do copyDirRecursive' "inputDir" "outputDir"+ Strict+ FailEarly removeDirIfExists "outputDir" - it "copyDirRecursive, all fine and compare" $ do+ 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")+ ++ toString tmpDir' ++ "inputDir" ++ " "+ ++ toString tmpDir' ++ "outputDir") `shouldReturn` ExitSuccess removeDirIfExists "outputDir" -- posix failures --- it "copyDirRecursive, source directory does not exist" $+ it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $ copyDirRecursive' "doesNotExist" "outputDir"+ Strict+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "copyDirRecursive, no write permission on output dir" $+ it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $ copyDirRecursive' "inputDir" "noWritePerm/foo"+ Strict+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursive, cannot open output dir" $+ it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $ copyDirRecursive' "inputDir" "noPerms/foo"+ Strict+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursive, cannot open source dir" $+ it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $ copyDirRecursive' "noPerms/inputDir" "foo"+ Strict+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyDirRecursive, destination dir already exists" $+ it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $ copyDirRecursive' "inputDir" "alreadyExistsD"+ Strict+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) - it "copyDirRecursive, destination already exists and is a file" $+ it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $ copyDirRecursive' "inputDir" "alreadyExists"+ Strict+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) - it "copyDirRecursive, wrong input (regular file)" $+ it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $ copyDirRecursive' "wrongInput" "outputDir"+ Strict+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyDirRecursive, wrong input (symlink to directory)" $+ it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $ copyDirRecursive' "wrongInputSymL" "outputDir"+ Strict+ FailEarly `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) -- custom failures- it "copyDirRecursive, destination in source" $+ it "copyDirRecursive (Strict, FailEarly), destination in source" $ copyDirRecursive' "inputDir" "inputDir/foo"+ Strict+ FailEarly `shouldThrow` isDestinationInSource - it "copyDirRecursive, destination and source same directory" $+ it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $ copyDirRecursive' "inputDir" "inputDir"+ Strict+ FailEarly `shouldThrow` isSameFile++
test/HPath/IO/CopyFileOverwriteSpec.hs view
@@ -4,6 +4,7 @@ import Test.Hspec+import HPath.IO import HPath.IO.Errors import System.IO.Error (@@ -16,10 +17,16 @@ import System.Exit import System.Process import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString)+import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CopyFileOverwriteSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "inputFile"@@ -51,79 +58,91 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $- describe "HPath.IO.copyFileOverwrite" $ do+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+ describe "HPath.IO.copyFile" $ do -- successes --- it "copyFileOverwrite, everything clear" $ do- copyFileOverwrite' "inputFile"+ it "copyFile (Overwrite), everything clear" $ do+ copyFile' "inputFile" "outputFile"+ Overwrite removeFileIfExists "outputFile" - it "copyFileOverwrite, output file already exists, all clear" $ do- copyFile' "alreadyExists" "alreadyExists.bak"- copyFileOverwrite' "inputFile"- "alreadyExists"- (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "- ++ toString tmpDir ++ "alreadyExists")+ it "copyFile (Overwrite), output file already exists, all clear" $ do+ tmpDir' <- getRawTmpDir+ copyFile' "alreadyExists" "alreadyExists.bak" Strict+ copyFile' "inputFile" "alreadyExists" Overwrite+ (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "+ ++ toString tmpDir' ++ "alreadyExists") `shouldReturn` ExitSuccess removeFileIfExists "alreadyExists"- copyFile' "alreadyExists.bak" "alreadyExists"+ copyFile' "alreadyExists.bak" "alreadyExists" Strict removeFileIfExists "alreadyExists.bak" - it "copyFileOverwrite, and compare" $ do- copyFileOverwrite' "inputFile"+ it "copyFile (Overwrite), and compare" $ do+ tmpDir' <- getRawTmpDir+ copyFile' "inputFile" "outputFile"- (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "- ++ toString tmpDir ++ "outputFile")+ Overwrite+ (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "+ ++ toString tmpDir' ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" + -- posix failures --- it "copyFileOverwrite, input file does not exist" $- copyFileOverwrite' "noSuchFile"+ it "copyFile (Overwrite), input file does not exist" $+ copyFile' "noSuchFile" "outputFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "copyFileOverwrite, no permission to write to output directory" $- copyFileOverwrite' "inputFile"+ it "copyFile (Overwrite), no permission to write to output directory" $+ copyFile' "inputFile" "outputDirNoWrite/outputFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFileOverwrite, cannot open output directory" $- copyFileOverwrite' "inputFile"+ it "copyFile (Overwrite), cannot open output directory" $+ copyFile' "inputFile" "noPerms/outputFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFileOverwrite, cannot open source directory" $- copyFileOverwrite' "noPerms/inputFile"+ it "copyFile (Overwrite), cannot open source directory" $+ copyFile' "noPerms/inputFile" "outputFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFileOverwrite, wrong input type (symlink)" $- copyFileOverwrite' "inputFileSymL"+ it "copyFile (Overwrite), wrong input type (symlink)" $+ copyFile' "inputFileSymL" "outputFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) - it "copyFileOverwrite, wrong input type (directory)" $- copyFileOverwrite' "wrongInput"+ it "copyFile (Overwrite), wrong input type (directory)" $+ copyFile' "wrongInput" "outputFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyFileOverwrite, output file already exists and is a dir" $- copyFileOverwrite' "inputFile"+ it "copyFile (Overwrite), output file already exists and is a dir" $+ copyFile' "inputFile" "alreadyExistsD"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) -- custom failures --- it "copyFileOverwrite, output and input are same file" $- copyFileOverwrite' "inputFile"+ it "copyFile (Overwrite), output and input are same file" $+ copyFile' "inputFile" "inputFile"+ Overwrite `shouldThrow` isSameFile
test/HPath/IO/CopyFileSpec.hs view
@@ -5,6 +5,7 @@ import Test.Hspec+import HPath.IO import HPath.IO.Errors import System.IO.Error (@@ -17,10 +18,15 @@ import System.Exit import System.Process import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString)+import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CopyFileSpec"+ createTmpDir+ setupFiles :: IO () setupFiles = do createRegularFile' "inputFile"@@ -51,75 +57,87 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.copyFile" $ do -- successes --- it "copyFile, everything clear" $ do+ it "copyFile (Strict), everything clear" $ do copyFile' "inputFile" "outputFile"+ Strict removeFileIfExists "outputFile" - it "copyFile, and compare" $ do+ it "copyFile (Strict), and compare" $ do+ tmpDir' <- getRawTmpDir copyFile' "inputFile" "outputFile"- (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "- ++ toString tmpDir ++ "outputFile")+ Strict+ (system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " "+ ++ toString tmpDir' ++ "outputFile") `shouldReturn` ExitSuccess removeFileIfExists "outputFile" -- posix failures --- it "copyFile, input file does not exist" $+ it "copyFile (Strict), input file does not exist" $ copyFile' "noSuchFile" "outputFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "copyFile, no permission to write to output directory" $+ it "copyFile (Strict), no permission to write to output directory" $ copyFile' "inputFile" "outputDirNoWrite/outputFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFile, cannot open output directory" $+ it "copyFile (Strict), cannot open output directory" $ copyFile' "inputFile" "noPerms/outputFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFile, cannot open source directory" $+ it "copyFile (Strict), cannot open source directory" $ copyFile' "noPerms/inputFile" "outputFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "copyFile, wrong input type (symlink)" $+ it "copyFile (Strict), wrong input type (symlink)" $ copyFile' "inputFileSymL" "outputFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) - it "copyFile, wrong input type (directory)" $+ it "copyFile (Strict), wrong input type (directory)" $ copyFile' "wrongInput" "outputFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == InappropriateType) - it "copyFile, output file already exists" $+ it "copyFile (Strict), output file already exists" $ copyFile' "inputFile" "alreadyExists"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) - it "copyFile, output file already exists and is a dir" $+ it "copyFile (Strict), output file already exists and is a dir" $ copyFile' "inputFile" "alreadyExistsD"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) -- custom failures --- it "copyFile, output and input are same file" $+ it "copyFile (Strict), output and input are same file" $ copyFile' "inputFile" "inputFile"+ Strict `shouldThrow` isSameFile
test/HPath/IO/CreateDirSpec.hs view
@@ -13,10 +13,14 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CreateDirSpec"+ createTmpDir+ setupFiles :: IO () setupFiles = do createDir' "alreadyExists"@@ -37,7 +41,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.createDir" $ do -- successes --
test/HPath/IO/CreateRegularFileSpec.hs view
@@ -13,10 +13,14 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CreateRegularFileSpec"+ createTmpDir+ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists"@@ -25,8 +29,6 @@ noPerms "noPerms" noWritableDirPerms "noWritePerms" -- cleanupFiles :: IO () cleanupFiles = do normalDirPerms "noPerms"@@ -37,7 +39,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.createRegularFile" $ do -- successes --
test/HPath/IO/CreateSymlinkSpec.hs view
@@ -4,7 +4,6 @@ import Test.Hspec-import HPath.IO.Errors import System.IO.Error ( ioeGetErrorType@@ -14,10 +13,14 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) +upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "CreateSymlinkSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "alreadyExists"@@ -37,7 +40,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.createSymlink" $ do -- successes --
test/HPath/IO/DeleteDirRecursiveSpec.hs view
@@ -17,10 +17,15 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "DeleteDirRecursiveSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "file"@@ -46,7 +51,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.deleteDirRecursive" $ do -- successes --
test/HPath/IO/DeleteDirSpec.hs view
@@ -17,10 +17,16 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) +++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "DeleteDirSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "file"@@ -46,7 +52,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.deleteDir" $ do -- successes --
test/HPath/IO/DeleteFileSpec.hs view
@@ -4,6 +4,7 @@ import Test.Hspec+import HPath.IO import System.IO.Error ( ioeGetErrorType@@ -17,10 +18,14 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) +upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "DeleteFileSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "foo"@@ -41,7 +46,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.deleteFile" $ do -- successes --@@ -55,6 +60,7 @@ it "deleteFile, symlink, all fine" $ do recreateSymlink' "syml" "testFile"+ Strict deleteFile' "testFile" getSymbolicLinkStatus "testFile" `shouldThrow`
test/HPath/IO/GetDirsFilesSpec.hs view
@@ -3,18 +3,10 @@ module HPath.IO.GetDirsFilesSpec where -import Control.Applicative- (- (<$>)- ) import Data.List ( sort )-import Data.Maybe- (- fromJust- ) import qualified HPath as P import HPath.IO import Test.Hspec@@ -22,19 +14,19 @@ ( ioeGetErrorType )-import System.Posix.Env.ByteString- (- getEnv- ) import GHC.IO.Exception ( IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) +upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "GetDirsFilesSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "file"@@ -61,7 +53,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.getDirsFiles" $ do -- successes --
test/HPath/IO/GetFileTypeSpec.hs view
@@ -14,10 +14,15 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "GetFileTypeSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "regularfile"@@ -42,7 +47,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.getFileType" $ do -- successes --
test/HPath/IO/MoveFileOverwriteSpec.hs view
@@ -4,6 +4,7 @@ import Test.Hspec+import HPath.IO import HPath.IO.Errors import System.IO.Error (@@ -14,10 +15,15 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "MoveFileOverwriteSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "myFile"@@ -45,65 +51,76 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $- describe "HPath.IO.moveFileOverwrite" $ do+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $+ describe "HPath.IO.moveFile" $ do -- successes --- it "moveFileOverwrite, all fine" $- moveFileOverwrite' "myFile"- "movedFile"+ it "moveFile (Overwrite), all fine" $+ moveFile' "myFile"+ "movedFile"+ Overwrite - it "moveFileOverwrite, all fine" $- moveFileOverwrite' "myFile"- "dir/movedFile"+ it "moveFile (Overwrite), all fine" $+ moveFile' "myFile"+ "dir/movedFile"+ Overwrite - it "moveFileOverwrite, all fine on symlink" $- moveFileOverwrite' "myFileL"- "movedFile"+ it "moveFile (Overwrite), all fine on symlink" $+ moveFile' "myFileL"+ "movedFile"+ Overwrite - it "moveFileOverwrite, all fine on directory" $- moveFileOverwrite' "dir"- "movedFile"+ it "moveFile (Overwrite), all fine on directory" $+ moveFile' "dir"+ "movedFile"+ Overwrite - it "moveFileOverwrite, destination file already exists" $- moveFileOverwrite' "myFile"- "alreadyExists"+ it "moveFile (Overwrite), destination file already exists" $+ moveFile' "myFile"+ "alreadyExists"+ Overwrite -- posix failures --- it "moveFileOverwrite, source file does not exist" $- moveFileOverwrite' "fileDoesNotExist"- "movedFile"+ it "moveFile (Overwrite), source file does not exist" $+ moveFile' "fileDoesNotExist"+ "movedFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "moveFileOverwrite, can't write to destination directory" $- moveFileOverwrite' "myFile"- "noWritePerm/movedFile"+ it "moveFile (Overwrite), can't write to destination directory" $+ moveFile' "myFile"+ "noWritePerm/movedFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "moveFileOverwrite, can't open destination directory" $- moveFileOverwrite' "myFile"- "noPerms/movedFile"+ it "moveFile (Overwrite), can't open destination directory" $+ moveFile' "myFile"+ "noPerms/movedFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "moveFileOverwrite, can't open source directory" $- moveFileOverwrite' "noPerms/myFile"- "movedFile"+ it "moveFile (Overwrite), can't open source directory" $+ moveFile' "noPerms/myFile"+ "movedFile"+ Overwrite `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures --- it "moveFileOverwrite, move from file to dir" $- moveFileOverwrite' "myFile"- "alreadyExistsD"++ it "moveFile (Overwrite), move from file to dir" $+ moveFile' "myFile"+ "alreadyExistsD"+ Overwrite `shouldThrow` isDirDoesExist - it "moveFileOverwrite, source and dest are same file" $- moveFileOverwrite' "myFile"- "myFile"+ it "moveFile (Overwrite), source and dest are same file" $+ moveFile' "myFile"+ "myFile"+ Overwrite `shouldThrow` isSameFile-
test/HPath/IO/MoveFileSpec.hs view
@@ -4,6 +4,7 @@ import Test.Hspec+import HPath.IO import HPath.IO.Errors import System.IO.Error (@@ -14,10 +15,15 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "MoveFileSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "myFile"@@ -47,67 +53,77 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.moveFile" $ do -- successes --- it "moveFile, all fine" $+ it "moveFile (Strict), all fine" $ moveFile' "myFile" "movedFile"+ Strict - it "moveFile, all fine" $+ it "moveFile (Strict), all fine" $ moveFile' "myFile" "dir/movedFile"+ Strict - it "moveFile, all fine on symlink" $+ it "moveFile (Strict), all fine on symlink" $ moveFile' "myFileL" "movedFile"+ Strict - it "moveFile, all fine on directory" $+ it "moveFile (Strict), all fine on directory" $ moveFile' "dir" "movedFile"+ Strict -- posix failures --- it "moveFile, source file does not exist" $+ it "moveFile (Strict), source file does not exist" $ moveFile' "fileDoesNotExist" "movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == NoSuchThing) - it "moveFile, can't write to destination directory" $+ it "moveFile (Strict), can't write to destination directory" $ moveFile' "myFile" "noWritePerm/movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "moveFile, can't open destination directory" $+ it "moveFile (Strict), can't open destination directory" $ moveFile' "myFile" "noPerms/movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "moveFile, can't open source directory" $+ it "moveFile (Strict), can't open source directory" $ moveFile' "noPerms/myFile" "movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) -- custom failures --- it "moveFile, destination file already exists" $+ it "moveFile (Strict), destination file already exists" $ moveFile' "myFile" "alreadyExists"+ Strict `shouldThrow` isFileDoesExist - it "moveFile, move from file to dir" $+ it "moveFile (Strict), move from file to dir" $ moveFile' "myFile" "alreadyExistsD"+ Strict `shouldThrow` isDirDoesExist - it "moveFile, source and dest are same file" $+ it "moveFile (Strict), source and dest are same file" $ moveFile' "myFile" "myFile"+ Strict `shouldThrow` isSameFile-
+ 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
@@ -3,7 +3,10 @@ module HPath.IO.RecreateSymlinkSpec where ++ import Test.Hspec+import HPath.IO import HPath.IO.Errors import System.IO.Error (@@ -14,10 +17,15 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "RecreateSymlinkSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "myFile"@@ -46,67 +54,77 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.recreateSymlink" $ do -- successes --- it "recreateSymLink, all fine" $ do+ it "recreateSymLink (Strict), all fine" $ do recreateSymlink' "myFileL" "movedFile"+ Strict removeFileIfExists "movedFile" - it "recreateSymLink, all fine" $ do+ it "recreateSymLink (Strict), all fine" $ do recreateSymlink' "myFileL" "dir/movedFile"+ Strict removeFileIfExists "dir/movedFile" -- posix failures --- it "recreateSymLink, wrong input type (file)" $+ it "recreateSymLink (Strict), wrong input type (file)" $ recreateSymlink' "myFile" "movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) - it "recreateSymLink, wrong input type (directory)" $+ it "recreateSymLink (Strict), wrong input type (directory)" $ recreateSymlink' "dir" "movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == InvalidArgument) - it "recreateSymLink, can't write to destination directory" $+ it "recreateSymLink (Strict), can't write to destination directory" $ recreateSymlink' "myFileL" "noWritePerm/movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "recreateSymLink, can't open destination directory" $+ it "recreateSymLink (Strict), can't open destination directory" $ recreateSymlink' "myFileL" "noPerms/movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "recreateSymLink, can't open source directory" $+ it "recreateSymLink (Strict), can't open source directory" $ recreateSymlink' "noPerms/myFileL" "movedFile"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == PermissionDenied) - it "recreateSymLink, destination file already exists" $+ it "recreateSymLink (Strict), destination file already exists" $ recreateSymlink' "myFileL" "alreadyExists"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) - it "recreateSymLink, destination already exists and is a dir" $+ it "recreateSymLink (Strict), destination already exists and is a dir" $ recreateSymlink' "myFileL" "alreadyExistsD"+ Strict `shouldThrow` (\e -> ioeGetErrorType e == AlreadyExists) -- custom failures --- it "recreateSymLink, source and destination are the same file" $+ it "recreateSymLink (Strict), source and destination are the same file" $ recreateSymlink' "myFileL" "myFileL"+ Strict `shouldThrow` isSameFile
test/HPath/IO/RenameFileSpec.hs view
@@ -14,10 +14,15 @@ IOErrorType(..) ) import Utils-import qualified Data.ByteString as BS-import Data.ByteString.UTF8 (toString) ++upTmpDir :: IO ()+upTmpDir = do+ setTmpDir "RenameFileSpec"+ createTmpDir++ setupFiles :: IO () setupFiles = do createRegularFile' "myFile"@@ -46,7 +51,7 @@ spec :: Spec-spec = before_ setupFiles $ after_ cleanupFiles $+spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ describe "HPath.IO.renameFile" $ do -- successes --
test/Main.hs view
@@ -14,10 +14,6 @@ main = hspecWith defaultConfig { configFormatter = Just progress }- $ before_ up- $ after_ down+ $ beforeAll_ createBaseTmpDir+ $ afterAll_ deleteBaseTmpDir $ Spec.spec- where- up = createTmpDir- down = deleteTmpDir-
test/Utils.hs view
@@ -11,8 +11,17 @@ ) import Control.Monad (- void+ forM_+ , void )+import qualified Data.ByteString as BS+import Data.IORef+ (+ newIORef+ , readIORef+ , writeIORef+ , IORef+ ) import HPath.IO import HPath.IO.Errors import HPath.IO.Utils@@ -21,6 +30,11 @@ fromJust ) import qualified HPath as P+import System.IO.Unsafe+ (+ unsafePerformIO+ )+import qualified System.Posix.Directory.Traversals as DT import System.Posix.Env.ByteString ( getEnv@@ -47,41 +61,78 @@ -tmpDir :: ByteString-tmpDir = "test/HPath/IO/tmp/"+baseTmpDir :: ByteString+baseTmpDir = "test/HPath/IO/tmp/" +tmpDir :: IORef ByteString+{-# NOINLINE tmpDir #-}+tmpDir = unsafePerformIO (newIORef baseTmpDir) ++ ----------------- --[ Utilities ]-- ----------------- +setTmpDir :: ByteString -> IO ()+{-# NOINLINE setTmpDir #-}+setTmpDir bs = writeIORef tmpDir (baseTmpDir `BS.append` bs)++ createTmpDir :: IO ()+{-# NOINLINE createTmpDir #-} createTmpDir = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs- tmp <- P.parseRel tmpDir- void $ createDir (pwd P.</> tmp)+ tmp <- P.parseRel =<< readIORef tmpDir+ void $ createDir newDirPerms (pwd P.</> tmp) deleteTmpDir :: IO ()+{-# NOINLINE deleteTmpDir #-} deleteTmpDir = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs- tmp <- P.parseRel tmpDir+ tmp <- P.parseRel =<< readIORef tmpDir void $ deleteDir (pwd P.</> tmp) +createBaseTmpDir :: IO ()+{-# NOINLINE createBaseTmpDir #-}+createBaseTmpDir = do+ pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs+ tmp <- P.parseRel baseTmpDir+ void $ createDir newDirPerms (pwd P.</> tmp)+++deleteBaseTmpDir :: IO ()+{-# NOINLINE deleteBaseTmpDir #-}+deleteBaseTmpDir = do+ pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs+ tmp <- P.parseRel baseTmpDir+ contents <- getDirsFiles (pwd P.</> tmp)+ forM_ contents deleteDir+ void $ deleteDir (pwd P.</> tmp)++ withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a+{-# NOINLINE withRawTmpDir #-} withRawTmpDir f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs- tmp <- P.parseRel tmpDir+ tmp <- P.parseRel =<< readIORef tmpDir f (pwd P.</> 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 pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs- tmp <- P.parseRel tmpDir+ tmp <- P.parseRel =<< readIORef tmpDir p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip f p @@ -90,84 +141,80 @@ -> ByteString -> (P.Path P.Abs -> P.Path P.Abs -> IO a) -> IO a+{-# NOINLINE withTmpDir' #-} withTmpDir' ip1 ip2 f = do pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs- tmp <- P.parseRel tmpDir+ tmp <- P.parseRel =<< readIORef tmpDir p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1 p2 <- (pwd P.</> 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 -> IO ()-copyFile' inputFileP outputFileP =- withTmpDir' inputFileP outputFileP copyFile---copyFileOverwrite' :: ByteString -> ByteString -> IO ()-copyFileOverwrite' inputFileP outputFileP =- withTmpDir' inputFileP outputFileP copyFileOverwrite---copyDirRecursive' :: ByteString -> ByteString -> IO ()-copyDirRecursive' inputDirP outputDirP =- withTmpDir' inputDirP outputDirP copyDirRecursive+copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()+{-# NOINLINE copyFile' #-}+copyFile' inputFileP outputFileP cm =+ withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm) -copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO ()-copyDirRecursiveOverwrite' inputDirP outputDirP =- withTmpDir' inputDirP outputDirP copyDirRecursiveOverwrite+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 ()-createDir' dest = withTmpDir dest createDir+{-# NOINLINE createDir' #-}+createDir' dest = withTmpDir dest (createDir newDirPerms) createRegularFile' :: ByteString -> IO ()-createRegularFile' dest = withTmpDir dest createRegularFile+{-# 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 -> IO ()-moveFile' inputFileP outputFileP =- withTmpDir' inputFileP outputFileP $ \i o -> do- moveFile i o- moveFile o i---moveFileOverwrite' :: ByteString -> ByteString -> IO ()-moveFileOverwrite' inputFileP outputFileP =+moveFile' :: ByteString -> ByteString -> CopyMode -> IO ()+{-# NOINLINE moveFile' #-}+moveFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do- moveFileOverwrite i o- moveFile o i+ moveFile i o cm+ moveFile o i Strict -recreateSymlink' :: ByteString -> ByteString -> IO ()-recreateSymlink' inputFileP outputFileP =- withTmpDir' inputFileP outputFileP recreateSymlink+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@@ -180,42 +227,58 @@ 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 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 -> do fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing SPI.defaultFileFlags- SPB.fdWrite fd bs+ _ <- SPB.fdWrite fd bs SPI.closeFd fd+++allDirectoryContents' :: ByteString -> IO [ByteString]+{-# NOINLINE allDirectoryContents' #-}+allDirectoryContents' ip =+ withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p)+