hasufell/hpath
1
1
Fork 0
Code Issues 8 Pull Requests Releases Wiki Activity

New API: use CopyMode for overwriting and introduce RecursiveMode

Browse Source 
This allows to specify the behavior on recursive operations,
such that one can collect failures instead of dying on the first
failure.
This commit is contained in:
Julian Ospald 2016-06-05 03:10:28 +02:00
parent 2a0a88a96d
commit 64ae6db83a
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
23 changed files with 831 additions and 420 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
hpath.cabal
View File

@ -73,6 +73,7 @@ test-suite spec
Main-Is: Main.hs
other-modules:
HPath.IO.CanonicalizePathSpec
HPath.IO.CopyDirRecursiveCollectFailuresSpec
HPath.IO.CopyDirRecursiveOverwriteSpec
HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyFileOverwriteSpec
@ -87,6 +88,7 @@ test-suite spec
HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec
HPath.IO.RecreateSymlinkOverwriteSpec
HPath.IO.RecreateSymlinkSpec
HPath.IO.RenameFileSpec
Spec

287
src/HPath/IO.hs
View File

@ -37,14 +37,13 @@ module HPath.IO
(
-- * Types
FileType(..)
, RecursiveMode(..)
, CopyMode(..)
-- * File copying
, copyDirRecursive
, copyDirRecursiveOverwrite
, recreateSymlink
, copyFile
, copyFileOverwrite
, easyCopy
, easyCopyOverwrite
-- * File deletion
, deleteFile
, deleteDir
@ -60,7 +59,6 @@ module HPath.IO
-- * File renaming/moving
, renameFile
, moveFile
, moveFileOverwrite
-- * File permissions
, newFilePerms
, newDirPerms
@ -80,12 +78,14 @@ import Control.Applicative
)
import Control.Exception
(
bracket
IOException
, bracket
, throwIO
)
import Control.Monad
(
void
unless
, void
, when
)
import Data.ByteString
@ -96,6 +96,13 @@ import Data.Foldable
(
for_
)
import Data.IORef
(
IORef
, modifyIORef
, newIORef
, readIORef
)
import Data.Maybe
(
catMaybes
@ -131,7 +138,6 @@ import GHC.IO.Exception
import HPath
import HPath.Internal
import HPath.IO.Errors
import HPath.IO.Utils
import Prelude hiding (readFile)
import System.IO.Error
(
@ -213,6 +219,27 @@ data FileType = Directory
-- |The 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 and collects the failed sub-operation
-- and keeps on
-- recursing. At the end an exception describing the collected
-- failures will still be raised.
data RecursiveMode = 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
--------------------
@ -228,6 +255,10 @@ data FileType = Directory
-- and thus will ignore any file type that is not `RegularFile`,
-- `SymbolicLink` or `Directory`.
--
-- For `Overwrite` mode this does not prune destination directory contents,
-- so the destination might contain more files than the source after
-- the operation has completed.
--
-- Safety/reliability concerns:
--
-- * not atomic
@ -244,27 +275,51 @@ data FileType = Directory
-- - `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)
-- - `AlreadyExists` if destination already exists
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
-- - `RecursiveFailure` if any sub-operation failed (for `CollectFailures` RecursiveMode only)
--
-- Throws in `Strict` CopyMode only:
--
-- - `AlreadyExists` if destination already exists
--
-- Throws in `CollectFailures` RecursiveMode only:
--
-- - `AlreadyExists` if destination already exists
copyDirRecursive :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination
-> CopyMode
-> RecursiveMode
-> 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 <- handleIOE ce [] $ do
contents <- getDirsFiles fromp'
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
createDirectory (fromAbs destdirp') fmode'
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 +327,51 @@ copyDirRecursive fromp destdirp
ftype <- getFileType f
newdest <- (destdirp' </>) <$> basename f
case ftype of
SymbolicLink -> recreateSymlink f newdest
Directory -> go f newdest
RegularFile -> copyFile f newdest
_ -> return ()
-- |Like `copyDirRecursive` except it overwrites contents of directories
-- if any.
--
-- For directory contents, this has the same behavior as `easyCopyOverwrite`
-- and thus will ignore any file type that is not `RegularFile`,
-- `SymbolicLink` or `Directory`.
--
-- Throws:
--
-- - `NoSuchThing` if source directory does not exist
-- - `PermissionDenied` if output directory is not writable
-- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source directory is wrong type (symlink)
-- - `InvalidArgument` if source directory is wrong type (regular file)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- - `DestinationInSource` if destination is contained in source (`HPathIOException`)
copyDirRecursiveOverwrite :: Path Abs -- ^ source dir
-> Path Abs -- ^ full destination
-> IO ()
copyDirRecursiveOverwrite fromp destdirp
= do
-- for performance, sanity checks are only done for the top dir
throwSameFile fromp destdirp
throwDestinationInSource fromp destdirp
go fromp destdirp
where
go :: Path Abs -> Path Abs -> IO ()
go fromp' destdirp' = do
-- order is important here, so we don't get empty directories
-- on failure
contents <- getDirsFiles fromp'
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
catchIOError (createDirectory (fromAbs destdirp') fmode') $ \e ->
case ioeGetErrorType e of
AlreadyExists -> setFileMode (fromAbs destdirp') fmode'
_ -> ioError e
-- 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
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)
-- |Recreate a symlink.
--
-- In `Overwrite` mode only files and empty directories are deleted.
--
-- Safety/reliability concerns:
--
-- * `Overwrite` mode is inherently non-atomic
--
-- Throws:
--
-- - `InvalidArgument` if source file is wrong type (not a symlink)
-- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened
-- - `AlreadyExists` if destination file already exists
-- - `AlreadyExists` if destination file already exists (for `Strict` CopyMode only)
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
--
-- 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 +383,11 @@ recreateSymlink symsource newsym
-- examine file types. For a more high-level version, use `easyCopy`
-- instead.
--
-- In `Overwrite` 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,48 +402,22 @@ recreateSymlink symsource newsym
-- - `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)
-- - `AlreadyExists` if destination already exists
-- - `AlreadyExists` if destination already exists (for `Strict` CopyMode only)
-- - `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
copyFile from to cm = do
throwSameFile from to
_copyFile [SPDF.oNofollow]
case cm of
Strict -> _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
throwSameFile from to
Overwrite ->
catchIOError (_copyFile [SPDF.oNofollow]
[SPDF.oNofollow, SPDF.oTrunc]
from to) $ \e ->
@ -426,7 +428,7 @@ copyFileOverwrite from to = do
exists <- doesFileExist to
writable <- isWritable (dirname to)
if exists && writable
then deleteFile to >> copyFile from to
then deleteFile to >> copyFile from to Strict
else ioError e
_ -> ioError e
@ -490,38 +492,18 @@ _copyFile sflags dflags from to
-- * calls `copyDirRecursive` for directories
easyCopy :: Path Abs
-> Path Abs
-> CopyMode
-> RecursiveMode
-> IO ()
easyCopy from to = do
easyCopy from to cm rm = do
ftype <- getFileType from
case ftype of
SymbolicLink -> recreateSymlink from to
RegularFile -> copyFile from to
Directory -> copyDirRecursive from to
SymbolicLink -> recreateSymlink from to cm
RegularFile -> copyFile from to cm
Directory -> copyDirRecursive from to cm rm
_ -> 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
ftype <- getFileType from
case ftype of
SymbolicLink -> whenM (doesFileExist to) (deleteFile to)
>> recreateSymlink from to
RegularFile -> copyFileOverwrite from to
Directory -> copyDirRecursiveOverwrite from to
_ -> return ()
@ -725,56 +707,37 @@ renameFile fromf tof = do
--
-- 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`)
-- - `FileDoesExist` if destination file already exists (`HPathIOException`),
-- only for `Strict` CopyMode
-- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
-- only for `Strict` CopyMode
-- - `SameFile` if destination and source are the same file (`HPathIOException`)
--
-- Note: calls `rename` (but does not allow to rename over existing files)
moveFile :: Path Abs -- ^ file to move
-> Path Abs -- ^ destination
-> CopyMode
-> IO ()
moveFile from to = do
moveFile from to cm = do
throwSameFile from to
catchErrno [eXDEV] (renameFile from to) $ do
easyCopy from to
case cm of
Strict -> catchErrno [eXDEV] (renameFile from to) $ do
easyCopy from to Strict FailEarly
easyDelete from
-- |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
Overwrite -> do
ft <- getFileType from
writable <- isWritable $ dirname to
case ft of
@ -788,7 +751,9 @@ moveFileOverwrite from to = do
exists <- doesDirectoryExist to
when (exists && writable) (deleteDir to)
_ -> return ()
moveFile from to
moveFile from to Strict

29
src/HPath/IO/Errors.hs
View File

@ -9,7 +9,6 @@
--
-- Provides error handling.
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
module HPath.IO.Errors
@ -27,6 +26,7 @@ module HPath.IO.Errors
, isInvalidOperation
, isCan'tOpenDirectory
, isCopyFailed
, isRecursiveFailure
-- * Path based functions
, throwFileDoesExist
@ -70,10 +70,6 @@ import Data.ByteString.UTF8
(
toString
)
import Data.Data
(
Data(..)
)
import Data.Typeable
import Foreign.C.Error
(
@ -114,7 +110,8 @@ data HPathIOException = FileDoesNotExist ByteString
| InvalidOperation String
| Can'tOpenDirectory ByteString
| CopyFailed String
deriving (Typeable, Eq, Data)
| RecursiveFailure [IOException]
deriving (Typeable, Eq)
instance Show HPathIOException where
@ -133,6 +130,22 @@ instance Show HPathIOException where
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"
@ -146,7 +159,7 @@ instance Exception HPathIOException
--[ 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 +169,7 @@ 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{}

2
test/HPath/IO/CanonicalizePathSpec.hs
View File

@ -13,8 +13,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)

245
test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs Normal file
View File

@ -0,0 +1,245 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CopyDirRecursiveCollectFailuresSpec where
import Test.Hspec
import Data.List (sort)
import Data.Maybe (fromJust)
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import System.Exit
import System.Process
import System.Posix.Env.ByteString
(
getEnv
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
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 = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyDirRecursive" $ do
-- successes --
it "copyDirRecursive (Strict, CollectFailures), all fine and compare" $ do
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 [e1, e2]) ->
ioeGetErrorType e1 == InappropriateType &&
ioeGetErrorType e2 == PermissionDenied)
normalDirPerms "outputDir1/foo2/foo4"
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
c <- allDirectoryContents' "outputDir1"
pwd <- fromJust <$> getEnv "PWD"
let shouldC = (fmap (\x -> pwd `BS.append` "/" `BS.append`
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"])
sort c `shouldBe` sort shouldC
deleteFile' "outputDir1/foo2/inputFile1"
deleteFile' "outputDir1/foo2/inputFile2"
deleteFile' "outputDir1/foo2/inputFile3"
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

77
test/HPath/IO/CopyDirRecursiveOverwriteSpec.hs
View File

@ -5,6 +5,7 @@ module HPath.IO.CopyDirRecursiveOverwriteSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@ -17,7 +18,6 @@ import GHC.IO.Exception
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
@ -82,88 +82,113 @@ cleanupFiles = do
spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyDirRecursiveOverwrite" $ do
describe "HPath.IO.copyDirRecursive" $ do
-- successes --
it "copyDirRecursiveOverwrite, all fine" $ do
copyDirRecursiveOverwrite' "inputDir"
it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do
copyDirRecursive' "inputDir"
"outputDir"
Overwrite
FailEarly
removeDirIfExists "outputDir"
it "copyDirRecursiveOverwrite, all fine and compare" $ do
copyDirRecursiveOverwrite' "inputDir"
it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do
copyDirRecursive' "inputDir"
"outputDir"
Overwrite
FailEarly
(system $ "diff -r --no-dereference "
++ 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
(system $ "diff -r --no-dereference "
++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir ++ "alreadyExistsD")
`shouldReturn` (ExitFailure 1)
copyDirRecursiveOverwrite' "inputDir"
copyDirRecursive' "inputDir"
"alreadyExistsD"
Overwrite
FailEarly
(system $ "diff -r --no-dereference "
++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir ++ "alreadyExistsD")
`shouldReturn` ExitSuccess
removeDirIfExists "outputDir"
-- posix failures --
it "copyDirRecursiveOverwrite, source directory does not exist" $
copyDirRecursiveOverwrite' "doesNotExist"
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"
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"
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"
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"
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"
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"
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"
it "copyDirRecursive (Overwrite, FailEarly), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Overwrite
FailEarly
`shouldThrow`
isDestinationInSource
it "copyDirRecursiveOverwrite, destination and source same directory" $
copyDirRecursiveOverwrite' "inputDir"
it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Overwrite
FailEarly
`shouldThrow`
isSameFile

54
test/HPath/IO/CopyDirRecursiveSpec.hs
View File

@ -5,6 +5,7 @@ module HPath.IO.CopyDirRecursiveSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@ -17,13 +18,10 @@ import GHC.IO.Exception
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()
setupFiles = do
createRegularFile' "alreadyExists"
@ -73,14 +71,18 @@ spec = before_ setupFiles $ after_ 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
copyDirRecursive' "inputDir"
"outputDir"
Strict
FailEarly
(system $ "diff -r --no-dereference "
++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir ++ "outputDir")
@ -88,63 +90,85 @@ spec = before_ setupFiles $ after_ cleanupFiles $
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

64
test/HPath/IO/CopyFileOverwriteSpec.hs
View File

@ -4,6 +4,7 @@ module HPath.IO.CopyFileOverwriteSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@ -16,7 +17,6 @@ import GHC.IO.Exception
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
@ -52,78 +52,88 @@ cleanupFiles = do
spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyFileOverwrite" $ do
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"
it "copyFile (Overwrite), output file already exists, all clear" $ do
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
copyFile' "inputFile"
"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

35
test/HPath/IO/CopyFileSpec.hs
View File

@ -5,6 +5,7 @@ module HPath.IO.CopyFileSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@ -17,7 +18,6 @@ import GHC.IO.Exception
import System.Exit
import System.Process
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
@ -55,71 +55,82 @@ spec = before_ setupFiles $ after_ 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
copyFile' "inputFile"
"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

2
test/HPath/IO/CreateDirSpec.hs
View File

@ -13,8 +13,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()

2
test/HPath/IO/CreateRegularFileSpec.hs
View File

@ -13,8 +13,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()

3
test/HPath/IO/CreateSymlinkSpec.hs
View File

@ -4,7 +4,6 @@ module HPath.IO.CreateSymlinkSpec where
import Test.Hspec
import HPath.IO.Errors
import System.IO.Error
(
ioeGetErrorType
@ -14,8 +13,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()

2
test/HPath/IO/DeleteDirRecursiveSpec.hs
View File

@ -17,8 +17,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()

2
test/HPath/IO/DeleteDirSpec.hs
View File

@ -17,8 +17,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()

4
test/HPath/IO/DeleteFileSpec.hs
View File

@ -4,6 +4,7 @@ module HPath.IO.DeleteFileSpec where
import Test.Hspec
import HPath.IO
import System.IO.Error
(
ioeGetErrorType
@ -17,8 +18,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()
@ -55,6 +54,7 @@ spec = before_ setupFiles $ after_ cleanupFiles $
it "deleteFile, symlink, all fine" $ do
recreateSymlink' "syml"
"testFile"
Strict
deleteFile' "testFile"
getSymbolicLinkStatus "testFile"
`shouldThrow`

14
test/HPath/IO/GetDirsFilesSpec.hs
View File

@ -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,17 +14,11 @@ import System.IO.Error
(
ioeGetErrorType
)
import System.Posix.Env.ByteString
(
getEnv
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()

2
test/HPath/IO/GetFileTypeSpec.hs
View File

@ -14,8 +14,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()

62
test/HPath/IO/MoveFileOverwriteSpec.hs
View File

@ -4,6 +4,7 @@ module HPath.IO.MoveFileOverwriteSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@ -14,8 +15,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()
@ -46,64 +45,75 @@ cleanupFiles = do
spec :: Spec
spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.moveFileOverwrite" $ do
describe "HPath.IO.moveFile" $ do
-- successes --
it "moveFileOverwrite, all fine" $
moveFileOverwrite' "myFile"
it "moveFile (Overwrite), all fine" $
moveFile' "myFile"
"movedFile"
Overwrite
it "moveFileOverwrite, all fine" $
moveFileOverwrite' "myFile"
it "moveFile (Overwrite), all fine" $
moveFile' "myFile"
"dir/movedFile"
Overwrite
it "moveFileOverwrite, all fine on symlink" $
moveFileOverwrite' "myFileL"
it "moveFile (Overwrite), all fine on symlink" $
moveFile' "myFileL"
"movedFile"
Overwrite
it "moveFileOverwrite, all fine on directory" $
moveFileOverwrite' "dir"
it "moveFile (Overwrite), all fine on directory" $
moveFile' "dir"
"movedFile"
Overwrite
it "moveFileOverwrite, destination file already exists" $
moveFileOverwrite' "myFile"
it "moveFile (Overwrite), destination file already exists" $
moveFile' "myFile"
"alreadyExists"
Overwrite
-- posix failures --
it "moveFileOverwrite, source file does not exist" $
moveFileOverwrite' "fileDoesNotExist"
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"
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"
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"
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"
it "moveFile (Overwrite), move from file to dir" $
moveFile' "myFile"
"alreadyExistsD"
Overwrite
`shouldThrow`
isDirDoesExist
it "moveFileOverwrite, source and dest are same file" $
moveFileOverwrite' "myFile"
it "moveFile (Overwrite), source and dest are same file" $
moveFile' "myFile"
"myFile"
Overwrite
`shouldThrow`
isSameFile

37
test/HPath/IO/MoveFileSpec.hs
View File

@ -4,6 +4,7 @@ module HPath.IO.MoveFileSpec where
import Test.Hspec
import HPath.IO
import HPath.IO.Errors
import System.IO.Error
(
@ -14,8 +15,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()
@ -51,63 +50,73 @@ spec = before_ setupFiles $ after_ 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

122
test/HPath/IO/RecreateSymlinkOverwriteSpec.hs Normal file
View File

@ -0,0 +1,122 @@
{-# 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
setupFiles :: IO ()
setupFiles = do
createRegularFile' "myFile"
createSymlink' "myFileL" "myFile"
createRegularFile' "alreadyExists"
createDir' "alreadyExistsD"
createDir' "dir"
createDir' "noPerms"
createDir' "noWritePerm"
noPerms "noPerms"
noWritableDirPerms "noWritePerm"
writeFile' "myFile" "Blahfaselgagaga"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerm"
deleteFile' "myFile"
deleteFile' "myFileL"
deleteFile' "alreadyExists"
deleteDir' "alreadyExistsD"
deleteDir' "dir"
deleteDir' "noPerms"
deleteDir' "noWritePerm"
spec :: Spec
spec = before_ setupFiles $ after_ 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 a dir" $ do
recreateSymlink' "myFileL"
"alreadyExistsD"
Overwrite
deleteFile' "alreadyExistsD"
createDir' "alreadyExistsD"
-- posix failures --
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

36
test/HPath/IO/RecreateSymlinkSpec.hs
View File

@ -3,7 +3,11 @@
module HPath.IO.RecreateSymlinkSpec 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
(
@ -14,8 +18,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()
@ -50,63 +52,73 @@ spec = before_ setupFiles $ after_ 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

2
test/HPath/IO/RenameFileSpec.hs
View File

@ -14,8 +14,6 @@ import GHC.IO.Exception
IOErrorType(..)
)
import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
setupFiles :: IO ()

56
test/Utils.hs
View File

@ -21,6 +21,10 @@ import Data.Maybe
fromJust
)
import qualified HPath as P
import System.Posix.Directory.Traversals
(
allDirectoryContents
)
import System.Posix.Env.ByteString
(
getEnv
@ -108,24 +112,15 @@ removeDirIfExists bs =
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
copyFile' :: ByteString -> ByteString -> IO ()
copyFile' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP copyFile
copyFile' :: ByteString -> ByteString -> CopyMode -> IO ()
copyFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm)
copyFileOverwrite' :: ByteString -> ByteString -> IO ()
copyFileOverwrite' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP copyFileOverwrite
copyDirRecursive' :: ByteString -> ByteString -> IO ()
copyDirRecursive' inputDirP outputDirP =
withTmpDir' inputDirP outputDirP copyDirRecursive
copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO ()
copyDirRecursiveOverwrite' inputDirP outputDirP =
withTmpDir' inputDirP outputDirP copyDirRecursiveOverwrite
copyDirRecursive' :: ByteString -> ByteString
-> CopyMode -> RecursiveMode -> IO ()
copyDirRecursive' inputDirP outputDirP cm rm =
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm)
createDir' :: ByteString -> IO ()
@ -148,23 +143,16 @@ renameFile' inputFileP outputFileP =
renameFile o i
moveFile' :: ByteString -> ByteString -> IO ()
moveFile' inputFileP outputFileP =
moveFile' :: ByteString -> ByteString -> CopyMode -> IO ()
moveFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP $ \i o -> do
moveFile i o
moveFile o i
moveFile i o cm
moveFile o i Strict
moveFileOverwrite' :: ByteString -> ByteString -> IO ()
moveFileOverwrite' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP $ \i o -> do
moveFileOverwrite i o
moveFile o i
recreateSymlink' :: ByteString -> ByteString -> IO ()
recreateSymlink' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP recreateSymlink
recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO ()
recreateSymlink' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm)
noWritableDirPerms :: ByteString -> IO ()
@ -217,5 +205,11 @@ 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]
allDirectoryContents' ip =
withTmpDir ip $ \p -> allDirectoryContents (P.fromAbs p)