2 Commits
test ... 0.7.5

Author SHA1 Message Date
9f7a4061fc Release 0.7.5 2016-06-04 00:40:27 +02:00
d8e2d30468 Relicense to BSD3 2016-06-04 00:39:45 +02:00
30 changed files with 603 additions and 1368 deletions

View File

@@ -1,9 +1,3 @@
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: 0.7.5:
* relicense to BSD3 * relicense to BSD3
0.7.3: 0.7.3:

View File

@@ -1,5 +1,5 @@
name: hpath name: hpath
version: 0.8.0 version: 0.7.5
synopsis: Support for well-typed paths synopsis: Support for well-typed paths
description: Support for well-typed paths, utilizing ByteString under the hood. description: Support for well-typed paths, utilizing ByteString under the hood.
license: BSD3 license: BSD3
@@ -19,21 +19,18 @@ extra-source-files: README.md
library library
hs-source-dirs: src/ hs-source-dirs: src/
default-language: Haskell2010 default-language: Haskell2010
if impl(ghc >= 8.0) ghc-options: -Wall
ghc-options: -Wall -Wno-redundant-constraints
else
ghc-options: -Wall
c-sources: cbits/dirutils.c c-sources: cbits/dirutils.c
exposed-modules: HPath, exposed-modules: HPath,
HPath.IO, HPath.IO,
HPath.IO.Errors, HPath.IO.Errors,
HPath.IO.Utils,
System.Posix.Directory.Foreign, System.Posix.Directory.Foreign,
System.Posix.Directory.Traversals, System.Posix.Directory.Traversals,
System.Posix.FD, System.Posix.FD,
System.Posix.FilePath System.Posix.FilePath
other-modules: HPath.Internal other-modules: HPath.Internal
build-depends: base >= 4.2 && <5 build-depends: base >= 4.2 && <5
, IfElse
, bytestring >= 0.9.2.0 , bytestring >= 0.9.2.0
, deepseq , deepseq
, exceptions , exceptions
@@ -76,13 +73,11 @@ test-suite spec
Main-Is: Main.hs Main-Is: Main.hs
other-modules: other-modules:
HPath.IO.CanonicalizePathSpec HPath.IO.CanonicalizePathSpec
HPath.IO.CopyDirRecursiveCollectFailuresSpec
HPath.IO.CopyDirRecursiveOverwriteSpec HPath.IO.CopyDirRecursiveOverwriteSpec
HPath.IO.CopyDirRecursiveSpec HPath.IO.CopyDirRecursiveSpec
HPath.IO.CopyFileOverwriteSpec HPath.IO.CopyFileOverwriteSpec
HPath.IO.CopyFileSpec HPath.IO.CopyFileSpec
HPath.IO.CreateDirSpec HPath.IO.CreateDirSpec
HPath.IO.CreateDirRecursiveSpec
HPath.IO.CreateRegularFileSpec HPath.IO.CreateRegularFileSpec
HPath.IO.CreateSymlinkSpec HPath.IO.CreateSymlinkSpec
HPath.IO.DeleteDirRecursiveSpec HPath.IO.DeleteDirRecursiveSpec
@@ -92,7 +87,6 @@ test-suite spec
HPath.IO.GetFileTypeSpec HPath.IO.GetFileTypeSpec
HPath.IO.MoveFileOverwriteSpec HPath.IO.MoveFileOverwriteSpec
HPath.IO.MoveFileSpec HPath.IO.MoveFileSpec
HPath.IO.RecreateSymlinkOverwriteSpec
HPath.IO.RecreateSymlinkSpec HPath.IO.RecreateSymlinkSpec
HPath.IO.RenameFileSpec HPath.IO.RenameFileSpec
Spec Spec
@@ -100,7 +94,6 @@ test-suite spec
GHC-Options: -Wall GHC-Options: -Wall
Build-Depends: base Build-Depends: base
, HUnit , HUnit
, IfElse
, bytestring , bytestring
, hpath , hpath
, hspec >= 1.3 , hspec >= 1.3

0
mo
View File

View File

@@ -336,8 +336,6 @@ dirname (MkPath fp) = MkPath (takeDirectory $ dropTrailingPathSeparator fp)
-- --
-- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn) -- >>> basename (MkPath "/abc/def/dod") :: Maybe (Path Fn)
-- Just "dod" -- Just "dod"
-- >>> basename (MkPath "/abc/def/dod/") :: Maybe (Path Fn)
-- Just "dod"
-- >>> basename (MkPath "/") :: Maybe (Path Fn) -- >>> basename (MkPath "/") :: Maybe (Path Fn)
-- Nothing -- Nothing
basename :: MonadThrow m => Path b -> m (Path Fn) basename :: MonadThrow m => Path b -> m (Path Fn)

View File

@@ -37,13 +37,14 @@ module HPath.IO
( (
-- * Types -- * Types
FileType(..) FileType(..)
, RecursiveErrorMode(..)
, CopyMode(..)
-- * File copying -- * File copying
, copyDirRecursive , copyDirRecursive
, copyDirRecursiveOverwrite
, recreateSymlink , recreateSymlink
, copyFile , copyFile
, copyFileOverwrite
, easyCopy , easyCopy
, easyCopyOverwrite
-- * File deletion -- * File deletion
, deleteFile , deleteFile
, deleteDir , deleteDir
@@ -55,11 +56,11 @@ module HPath.IO
-- * File creation -- * File creation
, createRegularFile , createRegularFile
, createDir , createDir
, createDirRecursive
, createSymlink , createSymlink
-- * File renaming/moving -- * File renaming/moving
, renameFile , renameFile
, moveFile , moveFile
, moveFileOverwrite
-- * File permissions -- * File permissions
, newFilePerms , newFilePerms
, newDirPerms , newDirPerms
@@ -79,20 +80,14 @@ import Control.Applicative
) )
import Control.Exception import Control.Exception
( (
IOException bracket
, bracket
, throwIO , throwIO
) )
import Control.Monad import Control.Monad
( (
unless void
, void
, when , when
) )
import Control.Monad.IfElse
(
unlessM
)
import Data.ByteString import Data.ByteString
( (
ByteString ByteString
@@ -101,13 +96,6 @@ import Data.Foldable
( (
for_ for_
) )
import Data.IORef
(
IORef
, modifyIORef
, newIORef
, readIORef
)
import Data.Maybe import Data.Maybe
( (
catMaybes catMaybes
@@ -120,11 +108,9 @@ import Foreign.C.Error
( (
eEXIST eEXIST
, eINVAL , eINVAL
, eNOENT
, eNOSYS , eNOSYS
, eNOTEMPTY , eNOTEMPTY
, eXDEV , eXDEV
, getErrno
) )
import Foreign.C.Types import Foreign.C.Types
( (
@@ -145,6 +131,7 @@ import GHC.IO.Exception
import HPath import HPath
import HPath.Internal import HPath.Internal
import HPath.IO.Errors import HPath.IO.Errors
import HPath.IO.Utils
import Prelude hiding (readFile) import Prelude hiding (readFile)
import System.IO.Error import System.IO.Error
( (
@@ -226,28 +213,6 @@ data FileType = Directory
-- |The error mode for recursive operations.
--
-- On `FailEarly` the whole operation fails immediately if any of the
-- recursive sub-operations fail, which is sort of the default
-- for IO operations.
--
-- On `CollectFailures` skips errors in the recursion and keeps on recursing.
-- However all errors are collected in the `RecursiveFailure` error type,
-- which is raised finally if there was any error. Also note that
-- `RecursiveFailure` does not give any guarantees on the ordering
-- of the collected exceptions.
data RecursiveErrorMode = FailEarly
| CollectFailures
-- |The mode for copy and file moves.
-- Overwrite mode is usually not very well defined, but is a convenience
-- shortcut.
data CopyMode = Strict -- ^ fail if any target exists
| Overwrite -- ^ overwrite targets
-------------------- --------------------
@@ -256,22 +221,12 @@ data CopyMode = Strict -- ^ fail if any target exists
-- |Copies the contents of a directory recursively to the given destination, while preserving permissions. -- |Copies a directory recursively to the given destination.
-- Does not follow symbolic links. This behaves more or less like -- Does not follow symbolic links.
-- the following, without descending into the destination if it
-- already exists:
-- --
-- @ -- For directory contents, this has the same behavior as `easyCopy`
-- cp -a \/source\/dir \/destination\/somedir -- and thus will ignore any file type that is not `RegularFile`,
-- @ -- `SymbolicLink` or `Directory`.
--
-- For directory contents, this will ignore any file type that is not
-- `RegularFile`, `SymbolicLink` or `Directory`.
--
-- For `Overwrite` copy mode this does not prune destination directory
-- contents, so the destination might contain more files than the source after
-- the operation has completed. Permissions of existing directories are
-- fixed.
-- --
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
@@ -285,138 +240,113 @@ data CopyMode = Strict -- ^ fail if any target exists
-- Throws: -- Throws:
-- --
-- - `NoSuchThing` if source directory does not exist -- - `NoSuchThing` if source directory does not exist
-- - `PermissionDenied` if source directory can't be opened
-- - `SameFile` if source and destination are the same file
-- (`HPathIOException`)
-- - `DestinationInSource` if destination is contained in source
-- (`HPathIOException`)
--
-- Throws in `FailEarly` RecursiveErrorMode only:
--
-- - `PermissionDenied` if output directory is not writable -- - `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 (symlink)
-- - `InappropriateType` if source directory is wrong type (regular file) -- - `InvalidArgument` 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 -- - `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 copyDirRecursive :: Path Abs -- ^ source dir
-> Path Abs -- ^ destination (parent dirs -> Path Abs -- ^ full destination
-- are not automatically created)
-> CopyMode
-> RecursiveErrorMode
-> IO () -> IO ()
copyDirRecursive fromp destdirp cm rm copyDirRecursive fromp destdirp
= do = do
ce <- newIORef []
-- for performance, sanity checks are only done for the top dir -- for performance, sanity checks are only done for the top dir
throwSameFile fromp destdirp throwSameFile fromp destdirp
throwDestinationInSource fromp destdirp throwDestinationInSource fromp destdirp
go ce fromp destdirp go fromp destdirp
collectedExceptions <- readIORef ce
unless (null collectedExceptions)
(throwIO . RecursiveFailure $ collectedExceptions)
where where
go :: IORef [(RecursiveFailureHint, IOException)] go :: Path Abs -> Path Abs -> IO ()
-> Path Abs -> Path Abs -> IO () go fromp' destdirp' = do
go ce fromp' destdirp' = do -- order is important here, so we don't get empty directories
-- NOTE: order is important here, so we don't get empty directories
-- on failure -- on failure
contents <- getDirsFiles fromp'
-- get the contents of the source dir fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
contents <- handleIOE (ReadContentsFailed fromp' destdirp') ce [] $ do createDirectory (fromAbs destdirp') fmode'
contents <- getDirsFiles fromp'
-- create the destination dir and -- we can't use `easyCopy` here, because we want to call `go`
-- only return contents if we succeed
handleIOE (CreateDirFailed fromp' destdirp') ce [] $ do
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp')
case cm of
Strict -> createDirectory (fromAbs destdirp') fmode'
Overwrite -> catchIOError (createDirectory (fromAbs destdirp')
fmode')
$ \e ->
case ioeGetErrorType e of
AlreadyExists -> setFileMode (fromAbs destdirp')
fmode'
_ -> ioError e
return contents
-- NOTE: we can't use `easyCopy` here, because we want to call `go`
-- recursively to skip the top-level sanity checks -- recursively to skip the top-level sanity checks
-- if reading the contents and creating the destination dir worked,
-- then copy the contents to the destination too
for_ contents $ \f -> do for_ contents $ \f -> do
ftype <- getFileType f ftype <- getFileType f
newdest <- (destdirp' </>) <$> basename f newdest <- (destdirp' </>) <$> basename f
case ftype of case ftype of
SymbolicLink -> handleIOE (RecreateSymlinkFailed f newdest) ce () SymbolicLink -> recreateSymlink f newdest
$ recreateSymlink f newdest cm Directory -> go f newdest
Directory -> go ce f newdest RegularFile -> copyFile f newdest
RegularFile -> handleIOE (CopyFileFailed f newdest) ce ()
$ copyFile f newdest cm
_ -> return () _ -> return ()
-- helper to handle errors for both RecursiveErrorModes and return a
-- default value -- |Like `copyDirRecursive` except it overwrites contents of directories
handleIOE :: RecursiveFailureHint -- if any.
-> IORef [(RecursiveFailureHint, IOException)] --
-> a -> IO a -> IO a -- For directory contents, this has the same behavior as `easyCopyOverwrite`
handleIOE hint ce def = case rm of -- and thus will ignore any file type that is not `RegularFile`,
FailEarly -> handleIOError throwIO -- `SymbolicLink` or `Directory`.
CollectFailures -> handleIOError (\e -> modifyIORef ce ((hint, e):) --
>> return def) -- 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
_ -> return ()
-- |Recreate a symlink. -- |Recreate a symlink.
-- --
-- In `Overwrite` copy mode only files and empty directories are deleted.
--
-- Safety/reliability concerns:
--
-- * `Overwrite` mode is inherently non-atomic
--
-- Throws: -- Throws:
-- --
-- - `InvalidArgument` if source file is wrong type (not a symlink) -- - `InvalidArgument` if source file is wrong type (not a symlink)
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened -- - `PermissionDenied` if source directory cannot be opened
-- - `SameFile` if source and destination are the same file -- - `AlreadyExists` if destination file already exists
-- (`HPathIOException`) -- - `SameFile` if source and destination are the same file (`HPathIOException`)
--
--
-- Throws in `Strict` mode only:
--
-- - `AlreadyExists` if destination already exists
--
-- Throws in `Overwrite` mode only:
--
-- - `UnsatisfiedConstraints` if destination file is non-empty directory
-- --
-- Note: calls `symlink` -- Note: calls `symlink`
recreateSymlink :: Path Abs -- ^ the old symlink file recreateSymlink :: Path Abs -- ^ the old symlink file
-> Path Abs -- ^ destination file -> Path Abs -- ^ destination file
-> CopyMode
-> IO () -> IO ()
recreateSymlink symsource newsym cm recreateSymlink symsource newsym
= do = do
throwSameFile symsource newsym throwSameFile symsource newsym
sympoint <- readSymbolicLink (fromAbs symsource) 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) createSymbolicLink sympoint (fromAbs newsym)
@@ -428,11 +358,8 @@ recreateSymlink symsource newsym cm
-- examine file types. For a more high-level version, use `easyCopy` -- examine file types. For a more high-level version, use `easyCopy`
-- instead. -- instead.
-- --
-- In `Overwrite` copy mode only overwrites actual files, not directories.
--
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
-- * `Overwrite` mode is not atomic
-- * when used on `CharacterDevice`, reads the "contents" and copies -- * when used on `CharacterDevice`, reads the "contents" and copies
-- them to a regular file, which might take indefinitely -- them to a regular file, which might take indefinitely
-- * when used on `BlockDevice`, may either read the "contents" -- * when used on `BlockDevice`, may either read the "contents"
@@ -447,39 +374,61 @@ recreateSymlink symsource newsym cm
-- - `PermissionDenied` if output directory is not writable -- - `PermissionDenied` if output directory is not writable
-- - `PermissionDenied` if source directory can't be opened -- - `PermissionDenied` if source directory can't be opened
-- - `InvalidArgument` if source file is wrong type (symlink or directory) -- - `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 -- - `AlreadyExists` if destination already exists
-- - `SameFile` if source and destination are the same file (`HPathIOException`)
-- --
-- Note: calls `sendfile` and possibly `read`/`write` as fallback -- Note: calls `sendfile` and possibly `read`/`write` as fallback
copyFile :: Path Abs -- ^ source file copyFile :: Path Abs -- ^ source file
-> Path Abs -- ^ destination file -> Path Abs -- ^ destination file
-> CopyMode
-> IO () -> IO ()
copyFile from to cm = do copyFile from to = do
throwSameFile from to throwSameFile from to
_copyFile [SPDF.oNofollow]
case cm of [SPDF.oNofollow, SPDF.oExcl]
Strict -> _copyFile [SPDF.oNofollow] from to
[SPDF.oNofollow, SPDF.oExcl]
from to
Overwrite -> -- |Like `copyFile` except it overwrites the destination if it already
catchIOError (_copyFile [SPDF.oNofollow] -- exists.
[SPDF.oNofollow, SPDF.oTrunc] --
from to) $ \e -> -- Safety/reliability concerns:
case ioeGetErrorType e of --
-- if the destination file is not writable, we need to -- * when used on `CharacterDevice`, reads the "contents" and copies
-- figure out if we can still copy by deleting it first -- them to a regular file, which might take indefinitely
PermissionDenied -> do -- * when used on `BlockDevice`, may either read the "contents"
exists <- doesFileExist to -- and copy them to a regular file (potentially hanging indefinitely)
writable <- isWritable (dirname to) -- or may create a regular empty destination file
if exists && writable -- * when used on `NamedPipe`, will hang indefinitely
then deleteFile to >> copyFile from to Strict -- * not atomic, since it uses read/write
else ioError e --
_ -> ioError e -- 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
catchIOError (_copyFile [SPDF.oNofollow]
[SPDF.oNofollow, SPDF.oTrunc]
from to) $ \e ->
case ioeGetErrorType e of
-- if the destination file is not writable, we need to
-- figure out if we can still copy by deleting it first
PermissionDenied -> do
exists <- doesFileExist to
writable <- isWritable (dirname to)
if exists && writable
then deleteFile to >> copyFile from to
else ioError e
_ -> ioError e
_copyFile :: [SPDF.Flags] _copyFile :: [SPDF.Flags]
@@ -490,8 +439,8 @@ _copyFile :: [SPDF.Flags]
_copyFile sflags dflags from to _copyFile sflags dflags from to
= =
-- from sendfile(2) manpage: -- from sendfile(2) manpage:
-- Applications may wish to fall back to read(2)/write(2) in -- Applications may wish to fall back to read(2)/write(2) in the case
-- the case where sendfile() fails with EINVAL or ENOSYS. -- where sendfile() fails with EINVAL or ENOSYS.
withAbsPath to $ \to' -> withAbsPath from $ \from' -> withAbsPath to $ \to' -> withAbsPath from $ \from' ->
catchErrno [eINVAL, eNOSYS] catchErrno [eINVAL, eNOSYS]
(sendFileCopy from' to') (sendFileCopy from' to')
@@ -527,8 +476,7 @@ _copyFile sflags dflags from to
if size == 0 if size == 0
then return $ fromIntegral totalsize then return $ fromIntegral totalsize
else do rsize <- SPB.fdWriteBuf dfd buf size else do rsize <- SPB.fdWriteBuf dfd buf size
when (rsize /= size) (ioError $ userError when (rsize /= size) (throwIO . CopyFailed $ "wrong size!")
"wrong size!")
write' sfd dfd buf (totalsize + fromIntegral size) write' sfd dfd buf (totalsize + fromIntegral size)
@@ -542,18 +490,38 @@ _copyFile sflags dflags from to
-- * calls `copyDirRecursive` for directories -- * calls `copyDirRecursive` for directories
easyCopy :: Path Abs easyCopy :: Path Abs
-> Path Abs -> Path Abs
-> CopyMode
-> RecursiveErrorMode
-> IO () -> IO ()
easyCopy from to cm rm = do easyCopy from to = do
ftype <- getFileType from ftype <- getFileType from
case ftype of case ftype of
SymbolicLink -> recreateSymlink from to cm SymbolicLink -> recreateSymlink from to
RegularFile -> copyFile from to cm RegularFile -> copyFile from to
Directory -> copyDirRecursive from to cm rm Directory -> copyDirRecursive from to
_ -> return () _ -> 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 ()
@@ -676,18 +644,15 @@ executeFile fp args
--------------------- ---------------------
-- |Create an empty regular file at the given directory with the given -- |Create an empty regular file at the given directory with the given filename.
-- filename.
-- --
-- Throws: -- Throws:
-- --
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination file already exists
-- - `NoSuchThing` if any of the parent components of the path createRegularFile :: Path Abs -> IO ()
-- do not exist createRegularFile dest =
createRegularFile :: FileMode -> Path Abs -> IO () bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just newFilePerms)
createRegularFile fm dest =
bracket (SPI.openFd (fromAbs dest) SPI.WriteOnly (Just fm)
(SPI.defaultFileFlags { exclusive = True })) (SPI.defaultFileFlags { exclusive = True }))
SPI.closeFd SPI.closeFd
(\_ -> return ()) (\_ -> return ())
@@ -698,40 +663,9 @@ createRegularFile fm dest =
-- Throws: -- Throws:
-- --
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination already exists -- - `AlreadyExists` if destination directory already exists
-- - `NoSuchThing` if any of the parent components of the path createDir :: Path Abs -> IO ()
-- do not exist createDir dest = createDirectory (fromAbs dest) newDirPerms
createDir :: FileMode -> Path Abs -> IO ()
createDir fm dest = createDirectory (fromAbs dest) fm
-- |Create an empty directory at the given directory with the given filename.
-- All parent directories are created with the same filemode. This
-- basically behaves like:
--
-- @
-- mkdir -p \/some\/dir
-- @
--
-- Safety/reliability concerns:
--
-- * not atomic
--
-- Throws:
--
-- - `PermissionDenied` if any part of the path components do not
-- exist and cannot be written to
-- - `AlreadyExists` if destination already exists and
-- is not a directory
createDirRecursive :: FileMode -> Path Abs -> IO ()
createDirRecursive fm dest =
catchIOError (createDirectory (fromAbs dest) fm) $ \e -> do
errno <- getErrno
case errno of
en | en == eEXIST -> unlessM (doesDirectoryExist dest) (ioError e)
| en == eNOENT -> createDirRecursive fm (dirname dest)
>> createDirectory (fromAbs dest) fm
| otherwise -> ioError e
-- |Create a symlink. -- |Create a symlink.
@@ -740,8 +674,6 @@ createDirRecursive fm dest =
-- --
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `AlreadyExists` if destination file already exists -- - `AlreadyExists` if destination file already exists
-- - `NoSuchThing` if any of the parent components of the path
-- do not exist
-- --
-- Note: calls `symlink` -- Note: calls `symlink`
createSymlink :: Path Abs -- ^ destination file createSymlink :: Path Abs -- ^ destination file
@@ -771,11 +703,10 @@ createSymlink dest sympoint
-- - `NoSuchThing` if source file does not exist -- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened -- - `PermissionDenied` if source directory cannot be opened
-- - `UnsupportedOperation` if source and destination are on different -- - `UnsupportedOperation` if source and destination are on different devices
-- devices -- - `FileDoesExist` if destination file already exists (`HPathIOException`)
-- - `AlreadyExists` if destination already exists -- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
-- - `SameFile` if destination and source are the same file -- - `SameFile` if destination and source are the same file (`HPathIOException`)
-- (`HPathIOException`)
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Note: calls `rename` (but does not allow to rename over existing files)
renameFile :: Path Abs -> Path Abs -> IO () renameFile :: Path Abs -> Path Abs -> IO ()
@@ -794,54 +725,70 @@ renameFile fromf tof = do
-- --
-- Safety/reliability concerns: -- Safety/reliability concerns:
-- --
-- * `Overwrite` mode is not atomic
-- * copy-delete fallback is inherently non-atomic -- * copy-delete fallback is inherently non-atomic
-- * since this function calls `easyCopy` and `easyDelete` as a fallback -- * since this function calls `easyCopy` and `easyDelete` as a fallback
-- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink` -- to `renameFile`, file types that are not `RegularFile`, `SymbolicLink`
-- or `Directory` may be ignored -- or `Directory` may be ignored
-- * for `Overwrite` mode, the destination will be deleted (not recursively)
-- before moving
-- --
-- Throws: -- Throws:
-- --
-- - `NoSuchThing` if source file does not exist -- - `NoSuchThing` if source file does not exist
-- - `PermissionDenied` if output directory cannot be written to -- - `PermissionDenied` if output directory cannot be written to
-- - `PermissionDenied` if source directory cannot be opened -- - `PermissionDenied` if source directory cannot be opened
-- - `SameFile` if destination and source are the same file -- - `FileDoesExist` if destination file already exists (`HPathIOException`)
-- (`HPathIOException`) -- - `DirDoesExist` if destination directory already exists (`HPathIOException`)
-- -- - `SameFile` if destination and source are the same file (`HPathIOException`)
-- Throws in `Strict` mode only:
--
-- - `AlreadyExists` if destination already exists
-- --
-- Note: calls `rename` (but does not allow to rename over existing files) -- Note: calls `rename` (but does not allow to rename over existing files)
moveFile :: Path Abs -- ^ file to move moveFile :: Path Abs -- ^ file to move
-> Path Abs -- ^ destination -> Path Abs -- ^ destination
-> CopyMode
-> IO () -> IO ()
moveFile from to cm = do moveFile from to = do
throwSameFile from to throwSameFile from to
case cm of catchErrno [eXDEV] (renameFile from to) $ do
Strict -> catchErrno [eXDEV] (renameFile from to) $ do easyCopy from to
easyCopy from to Strict FailEarly easyDelete from
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
@@ -881,8 +828,6 @@ newDirPerms
-- |Gets all filenames of the given directory. This excludes "." and "..". -- |Gets all filenames of the given directory. This excludes "." and "..".
-- This version does not follow symbolic links. -- This version does not follow symbolic links.
-- --
-- The contents are not sorted and there is no guarantee on the ordering.
--
-- Throws: -- Throws:
-- --
-- - `NoSuchThing` if directory does not exist -- - `NoSuchThing` if directory does not exist

View File

@@ -16,20 +16,23 @@ module HPath.IO.Errors
( (
-- * Types -- * Types
HPathIOException(..) HPathIOException(..)
, RecursiveFailureHint(..)
-- * Exception identifiers -- * Exception identifiers
, isFileDoesNotExist
, isDirDoesNotExist
, isSameFile , isSameFile
, isDestinationInSource , isDestinationInSource
, isRecursiveFailure , isFileDoesExist
, isReadContentsFailed , isDirDoesExist
, isCreateDirFailed , isInvalidOperation
, isCopyFileFailed , isCan'tOpenDirectory
, isRecreateSymlinkFailed , isCopyFailed
-- * Path based functions -- * Path based functions
, throwFileDoesExist , throwFileDoesExist
, throwDirDoesExist , throwDirDoesExist
, throwFileDoesNotExist
, throwDirDoesNotExist
, throwSameFile , throwSameFile
, sameFile , sameFile
, throwDestinationInSource , throwDestinationInSource
@@ -37,6 +40,7 @@ module HPath.IO.Errors
, doesDirectoryExist , doesDirectoryExist
, isWritable , isWritable
, canOpenDirectory , canOpenDirectory
, throwCantOpenDirectory
-- * Error handling functions -- * Error handling functions
, catchErrno , catchErrno
@@ -58,10 +62,6 @@ import Control.Monad
forM forM
, when , when
) )
import Control.Monad.IfElse
(
whenM
)
import Data.ByteString import Data.ByteString
( (
ByteString ByteString
@@ -70,10 +70,11 @@ import Data.ByteString.UTF8
( (
toString toString
) )
import Data.Typeable import Data.Data
( (
Typeable Data(..)
) )
import Data.Typeable
import Foreign.C.Error import Foreign.C.Error
( (
getErrno getErrno
@@ -88,12 +89,11 @@ import {-# SOURCE #-} HPath.IO
( (
canonicalizePath canonicalizePath
) )
import HPath.IO.Utils
import System.IO.Error import System.IO.Error
( (
alreadyExistsErrorType catchIOError
, catchIOError
, ioeGetErrorType , ioeGetErrorType
, mkIOError
) )
import qualified System.Posix.Directory.ByteString as PFD import qualified System.Posix.Directory.ByteString as PFD
@@ -105,36 +105,40 @@ import System.Posix.Files.ByteString
import qualified System.Posix.Files.ByteString as PF import qualified System.Posix.Files.ByteString as PF
-- |Additional generic IO exceptions that the posix functions data HPathIOException = FileDoesNotExist ByteString
-- do not provide. | DirDoesNotExist ByteString
data HPathIOException = SameFile ByteString ByteString | SameFile ByteString ByteString
| DestinationInSource ByteString ByteString | DestinationInSource ByteString ByteString
| RecursiveFailure [(RecursiveFailureHint, IOException)] | FileDoesExist ByteString
deriving (Eq, Show, Typeable) | DirDoesExist ByteString
| InvalidOperation String
| Can'tOpenDirectory ByteString
| CopyFailed String
deriving (Typeable, Eq, Data)
-- |A type for giving failure hints on recursive failure, which allows instance Show HPathIOException where
-- to programmatically make choices without examining show (FileDoesNotExist fp) = "File does not exist:" ++ toString fp
-- the weakly typed I/O error attributes (like `ioeGetFileName`). show (DirDoesNotExist fp) = "Directory does not exist: "
-- ++ toString fp
-- The first argument to the data constructor is always the show (SameFile fp1 fp2) = toString fp1
-- source and the second the destination. ++ " and " ++ toString fp2
data RecursiveFailureHint = ReadContentsFailed (Path Abs) (Path Abs) ++ " are the same file!"
| CreateDirFailed (Path Abs) (Path Abs) show (DestinationInSource fp1 fp2) = toString fp1
| CopyFileFailed (Path Abs) (Path Abs) ++ " is contained in "
| RecreateSymlinkFailed (Path Abs) (Path Abs) ++ toString fp2
deriving (Eq, Show) show (FileDoesExist fp) = "File does exist: " ++ toString fp
show (DirDoesExist fp) = "Directory does exist: " ++ toString fp
show (InvalidOperation str) = "Invalid operation: " ++ str
show (Can'tOpenDirectory fp) = "Can't open directory: "
++ toString fp
show (CopyFailed str) = "Copying failed: " ++ str
instance Exception HPathIOException instance Exception HPathIOException
toConstr :: HPathIOException -> String
toConstr SameFile {} = "SameFile"
toConstr DestinationInSource {} = "DestinationInSource"
toConstr RecursiveFailure {} = "RecursiveFailure"
@@ -142,23 +146,16 @@ toConstr RecursiveFailure {} = "RecursiveFailure"
--[ Exception identifiers ]-- --[ Exception identifiers ]--
----------------------------- -----------------------------
isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed :: HPathIOException -> Bool
isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{}
isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{}
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{} isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{}
isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{} isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{}
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{} isFileDoesExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesExist{}
isDirDoesExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesExist{}
isInvalidOperation ex = toConstr (ex :: HPathIOException) == toConstr InvalidOperation{}
isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool isCan'tOpenDirectory ex = toConstr (ex :: HPathIOException) == toConstr Can'tOpenDirectory{}
isReadContentsFailed ReadContentsFailed{} = True isCopyFailed ex = toConstr (ex :: HPathIOException) == toConstr CopyFailed{}
isReadContentsFailed _ = False
isCreateDirFailed CreateDirFailed{} = True
isCreateDirFailed _ = False
isCopyFileFailed CopyFileFailed{} = True
isCopyFileFailed _ = False
isRecreateSymlinkFailed RecreateSymlinkFailed{} = True
isRecreateSymlinkFailed _ = False
@@ -168,28 +165,28 @@ isRecreateSymlinkFailed _ = False
---------------------------- ----------------------------
-- |Throws `AlreadyExists` `IOError` if file exists.
throwFileDoesExist :: Path Abs -> IO () throwFileDoesExist :: Path Abs -> IO ()
throwFileDoesExist fp = throwFileDoesExist fp =
whenM (doesFileExist fp) whenM (doesFileExist fp) (throwIO . FileDoesExist
(ioError . mkIOError . fromAbs $ fp)
alreadyExistsErrorType
"File already exists"
Nothing
$ (Just (toString $ fromAbs fp))
)
-- |Throws `AlreadyExists` `IOError` if directory exists.
throwDirDoesExist :: Path Abs -> IO () throwDirDoesExist :: Path Abs -> IO ()
throwDirDoesExist fp = throwDirDoesExist fp =
whenM (doesDirectoryExist fp) whenM (doesDirectoryExist fp) (throwIO . DirDoesExist
(ioError . mkIOError . fromAbs $ fp)
alreadyExistsErrorType
"Directory already exists"
Nothing throwFileDoesNotExist :: Path Abs -> IO ()
$ (Just (toString $ fromAbs fp)) throwFileDoesNotExist fp =
) unlessM (doesFileExist fp) (throwIO . FileDoesNotExist
. fromAbs $ fp)
throwDirDoesNotExist :: Path Abs -> IO ()
throwDirDoesNotExist fp =
unlessM (doesDirectoryExist fp) (throwIO . DirDoesNotExist
. fromAbs $ fp)
-- |Uses `isSameFile` and throws `SameFile` if it returns True. -- |Uses `isSameFile` and throws `SameFile` if it returns True.
@@ -274,6 +271,13 @@ canOpenDirectory fp =
return True return True
-- |Throws a `Can'tOpenDirectory` HPathIOException if the directory at the given
-- path cannot be opened.
throwCantOpenDirectory :: Path Abs -> IO ()
throwCantOpenDirectory fp =
unlessM (canOpenDirectory fp)
(throwIO . Can'tOpenDirectory . fromAbs $ fp)
-------------------------------- --------------------------------
@@ -353,4 +357,3 @@ reactOnError a ios fmios =
else y) else y)
(throwIO ex) (throwIO ex)
fmios fmios

32
src/HPath/IO/Utils.hs Normal file
View File

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

View File

@@ -10,7 +10,6 @@
-- Traversal and read operations on directories. -- Traversal and read operations on directories.
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-} {-# LANGUAGE PackageImports #-}
@@ -38,10 +37,7 @@ module System.Posix.Directory.Traversals (
, realpath , realpath
) where ) where
import Control.Applicative
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad import Control.Monad
import System.Posix.FilePath ((</>)) import System.Posix.FilePath ((</>))
import System.Posix.Directory.Foreign import System.Posix.Directory.Foreign

View File

@@ -13,15 +13,12 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CanonicalizePathSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createRegularFile' "file" createRegularFile' "file"
@@ -40,7 +37,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.canonicalizePath" $ do describe "HPath.IO.canonicalizePath" $ do
-- successes -- -- successes --

View File

@@ -1,247 +0,0 @@
{-# 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 (\(h, e) -> ioeGetErrorType e == InappropriateType
&& isCopyFileFailed h) ex &&
any (\(h, e) -> ioeGetErrorType e == PermissionDenied
&& isReadContentsFailed h) ex)
normalDirPerms "outputDir1/foo2/foo4"
normalDirPerms "outputDir1/foo2/foo4/inputFile4"
c <- allDirectoryContents' "outputDir1"
tmpDir' <- getRawTmpDir
let shouldC = (fmap (\x -> tmpDir' `BS.append` x)
["outputDir1"
,"outputDir1/foo2"
,"outputDir1/foo2/inputFile1"
,"outputDir1/foo2/inputFile2"
,"outputDir1/foo2/inputFile3"
,"outputDir1/foo2/foo4"
,"outputDir1/foo2/foo4/inputFile6"
,"outputDir1/foo2/foo4/inputFile4"])
deleteFile' "outputDir1/foo2/inputFile1"
deleteFile' "outputDir1/foo2/inputFile2"
deleteFile' "outputDir1/foo2/inputFile3"
sort c `shouldBe` sort shouldC
it "copyDirRecursive (Strict, CollectFailures), no write permission on output dir" $
copyDirRecursive' "inputDir"
"noWritePerm/foo"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $
copyDirRecursive' "inputDir"
"noPerms/foo"
Strict
CollectFailures
`shouldThrow`
isRecursiveFailure
it "copyDirRecursive (Strict, CollectFailures), destination dir already exists" $
copyDirRecursive' "inputDir"
"alreadyExistsD"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $
copyDirRecursive' "inputDir"
"alreadyExists"
Strict
CollectFailures
`shouldThrow`
isRecursiveFailure
it "copyDirRecursive (Strict, CollectFailures), wrong input (regular file)" $
copyDirRecursive' "wrongInput"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL"
"outputDir"
Strict
CollectFailures
`shouldThrow`
(\(RecursiveFailure [(ReadContentsFailed{}, e)]) -> ioeGetErrorType e == InvalidArgument)
it "copyDirRecursive (Strict, CollectFailures), destination in source" $
copyDirRecursive' "inputDir"
"inputDir/foo"
Strict
CollectFailures
`shouldThrow`
isDestinationInSource
it "copyDirRecursive (Strict, CollectFailures), destination and source same directory" $
copyDirRecursive' "inputDir"
"inputDir"
Strict
CollectFailures
`shouldThrow`
isSameFile

View File

@@ -5,7 +5,6 @@ module HPath.IO.CopyDirRecursiveOverwriteSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -18,16 +17,11 @@ import GHC.IO.Exception
import System.Exit import System.Exit
import System.Process import System.Process
import Utils import Utils
import Data.ByteString.UTF8 (toString) import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyDirRecursiveOverwriteSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createRegularFile' "alreadyExists" createRegularFile' "alreadyExists"
@@ -87,116 +81,89 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyDirRecursive" $ do describe "HPath.IO.copyDirRecursiveOverwrite" $ do
-- successes -- -- successes --
it "copyDirRecursive (Overwrite, FailEarly), all fine" $ do it "copyDirRecursiveOverwrite, all fine" $ do
copyDirRecursive' "inputDir" copyDirRecursiveOverwrite' "inputDir"
"outputDir" "outputDir"
Overwrite
FailEarly
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
it "copyDirRecursive (Overwrite, FailEarly), all fine and compare" $ do it "copyDirRecursiveOverwrite, all fine and compare" $ do
tmpDir' <- getRawTmpDir copyDirRecursiveOverwrite' "inputDir"
copyDirRecursive' "inputDir" "outputDir"
"outputDir"
Overwrite
FailEarly
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " " ++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir") ++ toString tmpDir ++ "outputDir")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
it "copyDirRecursive (Overwrite, FailEarly), destination dir already exists" $ do it "copyDirRecursiveOverwrite, destination dir already exists" $ do
tmpDir' <- getRawTmpDir
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " " ++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir' ++ "alreadyExistsD") ++ toString tmpDir ++ "alreadyExistsD")
`shouldReturn` (ExitFailure 1) `shouldReturn` (ExitFailure 1)
copyDirRecursive' "inputDir" copyDirRecursiveOverwrite' "inputDir"
"alreadyExistsD" "alreadyExistsD"
Overwrite
FailEarly
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " " ++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir' ++ "alreadyExistsD") ++ toString tmpDir ++ "alreadyExistsD")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
-- posix failures -- -- posix failures --
it "copyDirRecursive, source directory does not exist" $ it "copyDirRecursiveOverwrite, source directory does not exist" $
copyDirRecursive' "doesNotExist" copyDirRecursiveOverwrite' "doesNotExist"
"outputDir" "outputDir"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive, no write permission on output dir" $ it "copyDirRecursiveOverwrite, no write permission on output dir" $
copyDirRecursive' "inputDir" copyDirRecursiveOverwrite' "inputDir"
"noWritePerm/foo" "noWritePerm/foo"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open output dir" $ it "copyDirRecursiveOverwrite, cannot open output dir" $
copyDirRecursive' "inputDir" copyDirRecursiveOverwrite' "inputDir"
"noPerms/foo" "noPerms/foo"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, cannot open source dir" $ it "copyDirRecursiveOverwrite, cannot open source dir" $
copyDirRecursive' "noPerms/inputDir" copyDirRecursiveOverwrite' "noPerms/inputDir"
"foo" "foo"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive, destination already exists and is a file" $ it "copyDirRecursiveOverwrite, destination already exists and is a file" $
copyDirRecursive' "inputDir" copyDirRecursiveOverwrite' "inputDir"
"alreadyExists" "alreadyExists"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive, wrong input (regular file)" $ it "copyDirRecursiveOverwrite, wrong input (regular file)" $
copyDirRecursive' "wrongInput" copyDirRecursiveOverwrite' "wrongInput"
"outputDir" "outputDir"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive, wrong input (symlink to directory)" $ it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL" copyDirRecursiveOverwrite' "wrongInputSymL"
"outputDir" "outputDir"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures -- custom failures
it "copyDirRecursive (Overwrite, FailEarly), destination in source" $ it "copyDirRecursiveOverwrite, destination in source" $
copyDirRecursive' "inputDir" copyDirRecursiveOverwrite' "inputDir"
"inputDir/foo" "inputDir/foo"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
isDestinationInSource isDestinationInSource
it "copyDirRecursive (Overwrite, FailEarly), destination and source same directory" $ it "copyDirRecursiveOverwrite, destination and source same directory" $
copyDirRecursive' "inputDir" copyDirRecursiveOverwrite' "inputDir"
"inputDir" "inputDir"
Overwrite
FailEarly
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -5,7 +5,6 @@ module HPath.IO.CopyDirRecursiveSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -18,14 +17,12 @@ import GHC.IO.Exception
import System.Exit import System.Exit
import System.Process import System.Process
import Utils import Utils
import Data.ByteString.UTF8 (toString) import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyDirRecursiveSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
@@ -72,109 +69,82 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyDirRecursive" $ do describe "HPath.IO.copyDirRecursive" $ do
-- successes -- -- successes --
it "copyDirRecursive (Strict, FailEarly), all fine" $ do it "copyDirRecursive, all fine" $ do
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"outputDir" "outputDir"
Strict
FailEarly
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
it "copyDirRecursive (Strict, FailEarly), all fine and compare" $ do it "copyDirRecursive, all fine and compare" $ do
tmpDir' <- getRawTmpDir
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"outputDir" "outputDir"
Strict
FailEarly
(system $ "diff -r --no-dereference " (system $ "diff -r --no-dereference "
++ toString tmpDir' ++ "inputDir" ++ " " ++ toString tmpDir ++ "inputDir" ++ " "
++ toString tmpDir' ++ "outputDir") ++ toString tmpDir ++ "outputDir")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeDirIfExists "outputDir" removeDirIfExists "outputDir"
-- posix failures -- -- posix failures --
it "copyDirRecursive (Strict, FailEarly), source directory does not exist" $ it "copyDirRecursive, source directory does not exist" $
copyDirRecursive' "doesNotExist" copyDirRecursive' "doesNotExist"
"outputDir" "outputDir"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyDirRecursive (Strict, FailEarly), no write permission on output dir" $ it "copyDirRecursive, no write permission on output dir" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"noWritePerm/foo" "noWritePerm/foo"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, FailEarly), cannot open output dir" $ it "copyDirRecursive, cannot open output dir" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"noPerms/foo" "noPerms/foo"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, FailEarly), cannot open source dir" $ it "copyDirRecursive, cannot open source dir" $
copyDirRecursive' "noPerms/inputDir" copyDirRecursive' "noPerms/inputDir"
"foo" "foo"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyDirRecursive (Strict, FailEarly), destination dir already exists" $ it "copyDirRecursive, destination dir already exists" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"alreadyExistsD" "alreadyExistsD"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive (Strict, FailEarly), destination already exists and is a file" $ it "copyDirRecursive, destination already exists and is a file" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"alreadyExists" "alreadyExists"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyDirRecursive (Strict, FailEarly), wrong input (regular file)" $ it "copyDirRecursive, wrong input (regular file)" $
copyDirRecursive' "wrongInput" copyDirRecursive' "wrongInput"
"outputDir" "outputDir"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyDirRecursive (Strict, FailEarly), wrong input (symlink to directory)" $ it "copyDirRecursive, wrong input (symlink to directory)" $
copyDirRecursive' "wrongInputSymL" copyDirRecursive' "wrongInputSymL"
"outputDir" "outputDir"
Strict
FailEarly
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
-- custom failures -- custom failures
it "copyDirRecursive (Strict, FailEarly), destination in source" $ it "copyDirRecursive, destination in source" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"inputDir/foo" "inputDir/foo"
Strict
FailEarly
`shouldThrow` `shouldThrow`
isDestinationInSource isDestinationInSource
it "copyDirRecursive (Strict, FailEarly), destination and source same directory" $ it "copyDirRecursive, destination and source same directory" $
copyDirRecursive' "inputDir" copyDirRecursive' "inputDir"
"inputDir" "inputDir"
Strict
FailEarly
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -4,7 +4,6 @@ module HPath.IO.CopyFileOverwriteSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -17,14 +16,8 @@ import GHC.IO.Exception
import System.Exit import System.Exit
import System.Process import System.Process
import Utils import Utils
import Data.ByteString.UTF8 (toString) import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileOverwriteSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -58,91 +51,79 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyFile" $ do describe "HPath.IO.copyFileOverwrite" $ do
-- successes -- -- successes --
it "copyFile (Overwrite), everything clear" $ do it "copyFileOverwrite, everything clear" $ do
copyFile' "inputFile" copyFileOverwrite' "inputFile"
"outputFile" "outputFile"
Overwrite
removeFileIfExists "outputFile" removeFileIfExists "outputFile"
it "copyFile (Overwrite), output file already exists, all clear" $ do it "copyFileOverwrite, output file already exists, all clear" $ do
tmpDir' <- getRawTmpDir copyFile' "alreadyExists" "alreadyExists.bak"
copyFile' "alreadyExists" "alreadyExists.bak" Strict copyFileOverwrite' "inputFile"
copyFile' "inputFile" "alreadyExists" Overwrite "alreadyExists"
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
++ toString tmpDir' ++ "alreadyExists") ++ toString tmpDir ++ "alreadyExists")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists "alreadyExists" removeFileIfExists "alreadyExists"
copyFile' "alreadyExists.bak" "alreadyExists" Strict copyFile' "alreadyExists.bak" "alreadyExists"
removeFileIfExists "alreadyExists.bak" removeFileIfExists "alreadyExists.bak"
it "copyFile (Overwrite), and compare" $ do it "copyFileOverwrite, and compare" $ do
tmpDir' <- getRawTmpDir copyFileOverwrite' "inputFile"
copyFile' "inputFile"
"outputFile" "outputFile"
Overwrite (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " ++ toString tmpDir ++ "outputFile")
++ toString tmpDir' ++ "outputFile")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists "outputFile" removeFileIfExists "outputFile"
-- posix failures -- -- posix failures --
it "copyFile (Overwrite), input file does not exist" $ it "copyFileOverwrite, input file does not exist" $
copyFile' "noSuchFile" copyFileOverwrite' "noSuchFile"
"outputFile" "outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile (Overwrite), no permission to write to output directory" $ it "copyFileOverwrite, no permission to write to output directory" $
copyFile' "inputFile" copyFileOverwrite' "inputFile"
"outputDirNoWrite/outputFile" "outputDirNoWrite/outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), cannot open output directory" $ it "copyFileOverwrite, cannot open output directory" $
copyFile' "inputFile" copyFileOverwrite' "inputFile"
"noPerms/outputFile" "noPerms/outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), cannot open source directory" $ it "copyFileOverwrite, cannot open source directory" $
copyFile' "noPerms/inputFile" copyFileOverwrite' "noPerms/inputFile"
"outputFile" "outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Overwrite), wrong input type (symlink)" $ it "copyFileOverwrite, wrong input type (symlink)" $
copyFile' "inputFileSymL" copyFileOverwrite' "inputFileSymL"
"outputFile" "outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile (Overwrite), wrong input type (directory)" $ it "copyFileOverwrite, wrong input type (directory)" $
copyFile' "wrongInput" copyFileOverwrite' "wrongInput"
"outputFile" "outputFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyFile (Overwrite), output file already exists and is a dir" $ it "copyFileOverwrite, output file already exists and is a dir" $
copyFile' "inputFile" copyFileOverwrite' "inputFile"
"alreadyExistsD" "alreadyExistsD"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
-- custom failures -- -- custom failures --
it "copyFile (Overwrite), output and input are same file" $ it "copyFileOverwrite, output and input are same file" $
copyFile' "inputFile" copyFileOverwrite' "inputFile"
"inputFile" "inputFile"
Overwrite
`shouldThrow` isSameFile `shouldThrow` isSameFile

View File

@@ -5,7 +5,6 @@ module HPath.IO.CopyFileSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -18,15 +17,10 @@ import GHC.IO.Exception
import System.Exit import System.Exit
import System.Process import System.Process
import Utils import Utils
import Data.ByteString.UTF8 (toString) import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CopyFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createRegularFile' "inputFile" createRegularFile' "inputFile"
@@ -57,87 +51,75 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.copyFile" $ do describe "HPath.IO.copyFile" $ do
-- successes -- -- successes --
it "copyFile (Strict), everything clear" $ do it "copyFile, everything clear" $ do
copyFile' "inputFile" copyFile' "inputFile"
"outputFile" "outputFile"
Strict
removeFileIfExists "outputFile" removeFileIfExists "outputFile"
it "copyFile (Strict), and compare" $ do it "copyFile, and compare" $ do
tmpDir' <- getRawTmpDir
copyFile' "inputFile" copyFile' "inputFile"
"outputFile" "outputFile"
Strict (system $ "cmp -s " ++ toString tmpDir ++ "inputFile" ++ " "
(system $ "cmp -s " ++ toString tmpDir' ++ "inputFile" ++ " " ++ toString tmpDir ++ "outputFile")
++ toString tmpDir' ++ "outputFile")
`shouldReturn` ExitSuccess `shouldReturn` ExitSuccess
removeFileIfExists "outputFile" removeFileIfExists "outputFile"
-- posix failures -- -- posix failures --
it "copyFile (Strict), input file does not exist" $ it "copyFile, input file does not exist" $
copyFile' "noSuchFile" copyFile' "noSuchFile"
"outputFile" "outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "copyFile (Strict), no permission to write to output directory" $ it "copyFile, no permission to write to output directory" $
copyFile' "inputFile" copyFile' "inputFile"
"outputDirNoWrite/outputFile" "outputDirNoWrite/outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Strict), cannot open output directory" $ it "copyFile, cannot open output directory" $
copyFile' "inputFile" copyFile' "inputFile"
"noPerms/outputFile" "noPerms/outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Strict), cannot open source directory" $ it "copyFile, cannot open source directory" $
copyFile' "noPerms/inputFile" copyFile' "noPerms/inputFile"
"outputFile" "outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "copyFile (Strict), wrong input type (symlink)" $ it "copyFile, wrong input type (symlink)" $
copyFile' "inputFileSymL" copyFile' "inputFileSymL"
"outputFile" "outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "copyFile (Strict), wrong input type (directory)" $ it "copyFile, wrong input type (directory)" $
copyFile' "wrongInput" copyFile' "wrongInput"
"outputFile" "outputFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InappropriateType) (\e -> ioeGetErrorType e == InappropriateType)
it "copyFile (Strict), output file already exists" $ it "copyFile, output file already exists" $
copyFile' "inputFile" copyFile' "inputFile"
"alreadyExists" "alreadyExists"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "copyFile (Strict), output file already exists and is a dir" $ it "copyFile, output file already exists and is a dir" $
copyFile' "inputFile" copyFile' "inputFile"
"alreadyExistsD" "alreadyExistsD"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures -- -- custom failures --
it "copyFile (Strict), output and input are same file" $ it "copyFile, output and input are same file" $
copyFile' "inputFile" copyFile' "inputFile"
"inputFile" "inputFile"
Strict
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -1,78 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module HPath.IO.CreateDirRecursiveSpec where
import Test.Hspec
import System.IO.Error
(
ioeGetErrorType
)
import GHC.IO.Exception
(
IOErrorType(..)
)
import Utils
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateDirRecursiveSpec"
createTmpDir
setupFiles :: IO ()
setupFiles = do
createDir' "alreadyExists"
createRegularFile' "alreadyExistsF"
createDir' "noPerms"
createDir' "noWritePerms"
noPerms "noPerms"
noWritableDirPerms "noWritePerms"
cleanupFiles :: IO ()
cleanupFiles = do
normalDirPerms "noPerms"
normalDirPerms "noWritePerms"
deleteDir' "alreadyExists"
deleteDir' "noPerms"
deleteDir' "noWritePerms"
deleteFile' "alreadyExistsF"
spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
describe "HPath.IO.createDirRecursive" $ do
-- successes --
it "createDirRecursive, all fine" $ do
createDirRecursive' "newDir"
deleteDir' "newDir"
it "createDirRecursive, parent directories do not exist" $ do
createDirRecursive' "some/thing/dada"
deleteDir' "some/thing/dada"
deleteDir' "some/thing"
deleteDir' "some"
it "createDirRecursive, destination directory already exists" $
createDirRecursive' "alreadyExists"
-- posix failures --
it "createDirRecursive, destination already exists and is a file" $
createDirRecursive' "alreadyExistsF"
`shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists)
it "createDirRecursive, can't write to output directory" $
createDirRecursive' "noWritePerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)
it "createDirRecursive, can't open output directory" $
createDirRecursive' "noPerms/newDir"
`shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied)

View File

@@ -13,14 +13,10 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateDirSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createDir' "alreadyExists" createDir' "alreadyExists"
@@ -41,7 +37,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.createDir" $ do describe "HPath.IO.createDir" $ do
-- successes -- -- successes --
@@ -50,11 +46,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
removeDirIfExists "newDir" removeDirIfExists "newDir"
-- posix failures -- -- posix failures --
it "createDir, parent directories do not exist" $
createDir' "some/thing/dada"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createDir, can't write to output directory" $ it "createDir, can't write to output directory" $
createDir' "noWritePerms/newDir" createDir' "noWritePerms/newDir"
`shouldThrow` `shouldThrow`

View File

@@ -13,14 +13,10 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateRegularFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
setupFiles = do setupFiles = do
createRegularFile' "alreadyExists" createRegularFile' "alreadyExists"
@@ -29,6 +25,8 @@ setupFiles = do
noPerms "noPerms" noPerms "noPerms"
noWritableDirPerms "noWritePerms" noWritableDirPerms "noWritePerms"
cleanupFiles :: IO () cleanupFiles :: IO ()
cleanupFiles = do cleanupFiles = do
normalDirPerms "noPerms" normalDirPerms "noPerms"
@@ -39,7 +37,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.createRegularFile" $ do describe "HPath.IO.createRegularFile" $ do
-- successes -- -- successes --
@@ -48,11 +46,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
removeFileIfExists "newDir" removeFileIfExists "newDir"
-- posix failures -- -- posix failures --
it "createRegularFile, parent directories do not exist" $
createRegularFile' "some/thing/dada"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createRegularFile, can't write to destination directory" $ it "createRegularFile, can't write to destination directory" $
createRegularFile' "noWritePerms/newDir" createRegularFile' "noWritePerms/newDir"
`shouldThrow` `shouldThrow`

View File

@@ -4,6 +4,7 @@ module HPath.IO.CreateSymlinkSpec where
import Test.Hspec import Test.Hspec
import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
ioeGetErrorType ioeGetErrorType
@@ -13,12 +14,8 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "CreateSymlinkSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -40,7 +37,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.createSymlink" $ do describe "HPath.IO.createSymlink" $ do
-- successes -- -- successes --
@@ -49,11 +46,6 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
removeFileIfExists "newSymL" removeFileIfExists "newSymL"
-- posix failures -- -- posix failures --
it "createSymlink, parent directories do not exist" $
createSymlink' "some/thing/dada" "lala"
`shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing)
it "createSymlink, can't write to destination directory" $ it "createSymlink, can't write to destination directory" $
createSymlink' "noWritePerms/newDir" "lala" createSymlink' "noWritePerms/newDir" "lala"
`shouldThrow` `shouldThrow`

View File

@@ -17,13 +17,8 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteDirRecursiveSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -51,7 +46,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.deleteDirRecursive" $ do describe "HPath.IO.deleteDirRecursive" $ do
-- successes -- -- successes --

View File

@@ -17,14 +17,8 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "DeleteDirSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -52,7 +46,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.deleteDir" $ do describe "HPath.IO.deleteDir" $ do
-- successes -- -- successes --

View File

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

View File

@@ -3,10 +3,18 @@
module HPath.IO.GetDirsFilesSpec where module HPath.IO.GetDirsFilesSpec where
import Control.Applicative
(
(<$>)
)
import Data.List import Data.List
( (
sort sort
) )
import Data.Maybe
(
fromJust
)
import qualified HPath as P import qualified HPath as P
import HPath.IO import HPath.IO
import Test.Hspec import Test.Hspec
@@ -14,17 +22,17 @@ import System.IO.Error
( (
ioeGetErrorType ioeGetErrorType
) )
import System.Posix.Env.ByteString
(
getEnv
)
import GHC.IO.Exception import GHC.IO.Exception
( (
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "GetDirsFilesSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -53,7 +61,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.getDirsFiles" $ do describe "HPath.IO.getDirsFiles" $ do
-- successes -- -- successes --

View File

@@ -14,13 +14,8 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "GetFileTypeSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -47,7 +42,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.getFileType" $ do describe "HPath.IO.getFileType" $ do
-- successes -- -- successes --

View File

@@ -4,7 +4,6 @@ module HPath.IO.MoveFileOverwriteSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -15,13 +14,8 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "MoveFileOverwriteSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -51,76 +45,65 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.moveFile" $ do describe "HPath.IO.moveFileOverwrite" $ do
-- successes -- -- successes --
it "moveFile (Overwrite), all fine" $ it "moveFileOverwrite, all fine" $
moveFile' "myFile" moveFileOverwrite' "myFile"
"movedFile" "movedFile"
Overwrite
it "moveFile (Overwrite), all fine" $ it "moveFileOverwrite, all fine" $
moveFile' "myFile" moveFileOverwrite' "myFile"
"dir/movedFile" "dir/movedFile"
Overwrite
it "moveFile (Overwrite), all fine on symlink" $ it "moveFileOverwrite, all fine on symlink" $
moveFile' "myFileL" moveFileOverwrite' "myFileL"
"movedFile" "movedFile"
Overwrite
it "moveFile (Overwrite), all fine on directory" $ it "moveFileOverwrite, all fine on directory" $
moveFile' "dir" moveFileOverwrite' "dir"
"movedFile" "movedFile"
Overwrite
it "moveFile (Overwrite), destination file already exists" $ it "moveFileOverwrite, destination file already exists" $
moveFile' "myFile" moveFileOverwrite' "myFile"
"alreadyExists" "alreadyExists"
Overwrite
-- posix failures -- -- posix failures --
it "moveFile (Overwrite), source file does not exist" $ it "moveFileOverwrite, source file does not exist" $
moveFile' "fileDoesNotExist" moveFileOverwrite' "fileDoesNotExist"
"movedFile" "movedFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "moveFile (Overwrite), can't write to destination directory" $ it "moveFileOverwrite, can't write to destination directory" $
moveFile' "myFile" moveFileOverwrite' "myFile"
"noWritePerm/movedFile" "noWritePerm/movedFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile (Overwrite), can't open destination directory" $ it "moveFileOverwrite, can't open destination directory" $
moveFile' "myFile" moveFileOverwrite' "myFile"
"noPerms/movedFile" "noPerms/movedFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile (Overwrite), can't open source directory" $ it "moveFileOverwrite, can't open source directory" $
moveFile' "noPerms/myFile" moveFileOverwrite' "noPerms/myFile"
"movedFile" "movedFile"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures -- -- custom failures --
it "moveFileOverwrite, move from file to dir" $
it "moveFile (Overwrite), move from file to dir" $ moveFileOverwrite' "myFile"
moveFile' "myFile" "alreadyExistsD"
"alreadyExistsD"
Overwrite
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) isDirDoesExist
it "moveFile (Overwrite), source and dest are same file" $ it "moveFileOverwrite, source and dest are same file" $
moveFile' "myFile" moveFileOverwrite' "myFile"
"myFile" "myFile"
Overwrite
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -4,7 +4,6 @@ module HPath.IO.MoveFileSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -15,13 +14,8 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "MoveFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -53,77 +47,67 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.moveFile" $ do describe "HPath.IO.moveFile" $ do
-- successes -- -- successes --
it "moveFile (Strict), all fine" $ it "moveFile, all fine" $
moveFile' "myFile" moveFile' "myFile"
"movedFile" "movedFile"
Strict
it "moveFile (Strict), all fine" $ it "moveFile, all fine" $
moveFile' "myFile" moveFile' "myFile"
"dir/movedFile" "dir/movedFile"
Strict
it "moveFile (Strict), all fine on symlink" $ it "moveFile, all fine on symlink" $
moveFile' "myFileL" moveFile' "myFileL"
"movedFile" "movedFile"
Strict
it "moveFile (Strict), all fine on directory" $ it "moveFile, all fine on directory" $
moveFile' "dir" moveFile' "dir"
"movedFile" "movedFile"
Strict
-- posix failures -- -- posix failures --
it "moveFile (Strict), source file does not exist" $ it "moveFile, source file does not exist" $
moveFile' "fileDoesNotExist" moveFile' "fileDoesNotExist"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == NoSuchThing) (\e -> ioeGetErrorType e == NoSuchThing)
it "moveFile (Strict), can't write to destination directory" $ it "moveFile, can't write to destination directory" $
moveFile' "myFile" moveFile' "myFile"
"noWritePerm/movedFile" "noWritePerm/movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile (Strict), can't open destination directory" $ it "moveFile, can't open destination directory" $
moveFile' "myFile" moveFile' "myFile"
"noPerms/movedFile" "noPerms/movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "moveFile (Strict), can't open source directory" $ it "moveFile, can't open source directory" $
moveFile' "noPerms/myFile" moveFile' "noPerms/myFile"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
-- custom failures -- -- custom failures --
it "moveFile (Strict), destination file already exists" $ it "moveFile, destination file already exists" $
moveFile' "myFile" moveFile' "myFile"
"alreadyExists" "alreadyExists"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) isFileDoesExist
it "moveFile (Strict), move from file to dir" $ it "moveFile, move from file to dir" $
moveFile' "myFile" moveFile' "myFile"
"alreadyExistsD" "alreadyExistsD"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) isDirDoesExist
it "moveFile (Strict), source and dest are same file" $ it "moveFile, source and dest are same file" $
moveFile' "myFile" moveFile' "myFile"
"myFile" "myFile"
Strict
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -1,139 +0,0 @@
{-# 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

View File

@@ -3,10 +3,7 @@
module HPath.IO.RecreateSymlinkSpec where module HPath.IO.RecreateSymlinkSpec where
import Test.Hspec import Test.Hspec
import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import System.IO.Error import System.IO.Error
( (
@@ -17,13 +14,8 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RecreateSymlinkSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -54,77 +46,67 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.recreateSymlink" $ do describe "HPath.IO.recreateSymlink" $ do
-- successes -- -- successes --
it "recreateSymLink (Strict), all fine" $ do it "recreateSymLink, all fine" $ do
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"movedFile" "movedFile"
Strict
removeFileIfExists "movedFile" removeFileIfExists "movedFile"
it "recreateSymLink (Strict), all fine" $ do it "recreateSymLink, all fine" $ do
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"dir/movedFile" "dir/movedFile"
Strict
removeFileIfExists "dir/movedFile" removeFileIfExists "dir/movedFile"
-- posix failures -- -- posix failures --
it "recreateSymLink (Strict), wrong input type (file)" $ it "recreateSymLink, wrong input type (file)" $
recreateSymlink' "myFile" recreateSymlink' "myFile"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink (Strict), wrong input type (directory)" $ it "recreateSymLink, wrong input type (directory)" $
recreateSymlink' "dir" recreateSymlink' "dir"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == InvalidArgument) (\e -> ioeGetErrorType e == InvalidArgument)
it "recreateSymLink (Strict), can't write to destination directory" $ it "recreateSymLink, can't write to destination directory" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"noWritePerm/movedFile" "noWritePerm/movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Strict), can't open destination directory" $ it "recreateSymLink, can't open destination directory" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"noPerms/movedFile" "noPerms/movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Strict), can't open source directory" $ it "recreateSymLink, can't open source directory" $
recreateSymlink' "noPerms/myFileL" recreateSymlink' "noPerms/myFileL"
"movedFile" "movedFile"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == PermissionDenied) (\e -> ioeGetErrorType e == PermissionDenied)
it "recreateSymLink (Strict), destination file already exists" $ it "recreateSymLink, destination file already exists" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"alreadyExists" "alreadyExists"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
it "recreateSymLink (Strict), destination already exists and is a dir" $ it "recreateSymLink, destination already exists and is a dir" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"alreadyExistsD" "alreadyExistsD"
Strict
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) (\e -> ioeGetErrorType e == AlreadyExists)
-- custom failures -- -- custom failures --
it "recreateSymLink (Strict), source and destination are the same file" $ it "recreateSymLink, source and destination are the same file" $
recreateSymlink' "myFileL" recreateSymlink' "myFileL"
"myFileL" "myFileL"
Strict
`shouldThrow` `shouldThrow`
isSameFile isSameFile

View File

@@ -14,13 +14,8 @@ import GHC.IO.Exception
IOErrorType(..) IOErrorType(..)
) )
import Utils import Utils
import qualified Data.ByteString as BS
import Data.ByteString.UTF8 (toString)
upTmpDir :: IO ()
upTmpDir = do
setTmpDir "RenameFileSpec"
createTmpDir
setupFiles :: IO () setupFiles :: IO ()
@@ -51,7 +46,7 @@ cleanupFiles = do
spec :: Spec spec :: Spec
spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ spec = before_ setupFiles $ after_ cleanupFiles $
describe "HPath.IO.renameFile" $ do describe "HPath.IO.renameFile" $ do
-- successes -- -- successes --
@@ -101,13 +96,13 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $
renameFile' "myFile" renameFile' "myFile"
"alreadyExists" "alreadyExists"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) isFileDoesExist
it "renameFile, move from file to dir" $ it "renameFile, move from file to dir" $
renameFile' "myFile" renameFile' "myFile"
"alreadyExistsD" "alreadyExistsD"
`shouldThrow` `shouldThrow`
(\e -> ioeGetErrorType e == AlreadyExists) isDirDoesExist
it "renameFile, source and dest are same file" $ it "renameFile, source and dest are same file" $
renameFile' "myFile" renameFile' "myFile"

View File

@@ -14,6 +14,10 @@ main :: IO ()
main = main =
hspecWith hspecWith
defaultConfig { configFormatter = Just progress } defaultConfig { configFormatter = Just progress }
$ beforeAll_ createBaseTmpDir $ before_ up
$ afterAll_ deleteBaseTmpDir $ after_ down
$ Spec.spec $ Spec.spec
where
up = createTmpDir
down = deleteTmpDir

View File

@@ -11,33 +11,16 @@ import Control.Applicative
) )
import Control.Monad import Control.Monad
( (
forM_ void
, void
)
import Control.Monad.IfElse
(
whenM
)
import qualified Data.ByteString as BS
import Data.IORef
(
newIORef
, readIORef
, writeIORef
, IORef
) )
import HPath.IO import HPath.IO
import HPath.IO.Errors import HPath.IO.Errors
import HPath.IO.Utils
import Data.Maybe import Data.Maybe
( (
fromJust fromJust
) )
import qualified HPath as P import qualified HPath as P
import System.IO.Unsafe
(
unsafePerformIO
)
import qualified System.Posix.Directory.Traversals as DT
import System.Posix.Env.ByteString import System.Posix.Env.ByteString
( (
getEnv getEnv
@@ -64,13 +47,8 @@ import qualified "unix-bytestring" System.Posix.IO.ByteString as SPB
baseTmpDir :: ByteString tmpDir :: ByteString
baseTmpDir = "test/HPath/IO/tmp/" tmpDir = "test/HPath/IO/tmp/"
tmpDir :: IORef ByteString
{-# NOINLINE tmpDir #-}
tmpDir = unsafePerformIO (newIORef baseTmpDir)
@@ -79,63 +57,31 @@ tmpDir = unsafePerformIO (newIORef baseTmpDir)
----------------- -----------------
setTmpDir :: ByteString -> IO ()
{-# NOINLINE setTmpDir #-}
setTmpDir bs = writeIORef tmpDir (baseTmpDir `BS.append` bs)
createTmpDir :: IO () createTmpDir :: IO ()
{-# NOINLINE createTmpDir #-}
createTmpDir = do createTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir tmp <- P.parseRel tmpDir
void $ createDir newDirPerms (pwd P.</> tmp) void $ createDir (pwd P.</> tmp)
deleteTmpDir :: IO () deleteTmpDir :: IO ()
{-# NOINLINE deleteTmpDir #-}
deleteTmpDir = do deleteTmpDir = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir tmp <- P.parseRel 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) void $ deleteDir (pwd P.</> tmp)
withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a withRawTmpDir :: (P.Path P.Abs -> IO a) -> IO a
{-# NOINLINE withRawTmpDir #-}
withRawTmpDir f = do withRawTmpDir f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir tmp <- P.parseRel tmpDir
f (pwd P.</> tmp) 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 withTmpDir :: ByteString -> (P.Path P.Abs -> IO a) -> IO a
{-# NOINLINE withTmpDir #-}
withTmpDir ip f = do withTmpDir ip f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir tmp <- P.parseRel tmpDir
p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip p <- (pwd P.</> tmp P.</>) <$> P.parseRel ip
f p f p
@@ -144,83 +90,84 @@ withTmpDir' :: ByteString
-> ByteString -> ByteString
-> (P.Path P.Abs -> P.Path P.Abs -> IO a) -> (P.Path P.Abs -> P.Path P.Abs -> IO a)
-> IO a -> IO a
{-# NOINLINE withTmpDir' #-}
withTmpDir' ip1 ip2 f = do withTmpDir' ip1 ip2 f = do
pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs pwd <- fromJust <$> getEnv "PWD" >>= P.parseAbs
tmp <- P.parseRel =<< readIORef tmpDir tmp <- P.parseRel tmpDir
p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1 p1 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip1
p2 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip2 p2 <- (pwd P.</> tmp P.</>) <$> P.parseRel ip2
f p1 p2 f p1 p2
removeFileIfExists :: ByteString -> IO () removeFileIfExists :: ByteString -> IO ()
{-# NOINLINE removeFileIfExists #-}
removeFileIfExists bs = removeFileIfExists bs =
withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p) withTmpDir bs $ \p -> whenM (doesFileExist p) (deleteFile p)
removeDirIfExists :: ByteString -> IO () removeDirIfExists :: ByteString -> IO ()
{-# NOINLINE removeDirIfExists #-}
removeDirIfExists bs = removeDirIfExists bs =
withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p) withTmpDir bs $ \p -> whenM (doesDirectoryExist p) (deleteDirRecursive p)
copyFile' :: ByteString -> ByteString -> CopyMode -> IO () copyFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE copyFile' #-} copyFile' inputFileP outputFileP =
copyFile' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP copyFile
withTmpDir' inputFileP outputFileP (\p1 p2 -> copyFile p1 p2 cm)
copyDirRecursive' :: ByteString -> ByteString copyFileOverwrite' :: ByteString -> ByteString -> IO ()
-> CopyMode -> RecursiveErrorMode -> IO () copyFileOverwrite' inputFileP outputFileP =
{-# NOINLINE copyDirRecursive' #-} withTmpDir' inputFileP outputFileP copyFileOverwrite
copyDirRecursive' inputDirP outputDirP cm rm =
withTmpDir' inputDirP outputDirP (\p1 p2 -> copyDirRecursive p1 p2 cm rm)
copyDirRecursive' :: ByteString -> ByteString -> IO ()
copyDirRecursive' inputDirP outputDirP =
withTmpDir' inputDirP outputDirP copyDirRecursive
copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO ()
copyDirRecursiveOverwrite' inputDirP outputDirP =
withTmpDir' inputDirP outputDirP copyDirRecursiveOverwrite
createDir' :: ByteString -> IO () createDir' :: ByteString -> IO ()
{-# NOINLINE createDir' #-} createDir' dest = withTmpDir dest createDir
createDir' dest = withTmpDir dest (createDir newDirPerms)
createDirRecursive' :: ByteString -> IO ()
{-# NOINLINE createDirRecursive' #-}
createDirRecursive' dest = withTmpDir dest (createDirRecursive newDirPerms)
createRegularFile' :: ByteString -> IO () createRegularFile' :: ByteString -> IO ()
{-# NOINLINE createRegularFile' #-} createRegularFile' dest = withTmpDir dest createRegularFile
createRegularFile' dest = withTmpDir dest (createRegularFile newFilePerms)
createSymlink' :: ByteString -> ByteString -> IO () createSymlink' :: ByteString -> ByteString -> IO ()
{-# NOINLINE createSymlink' #-}
createSymlink' dest sympoint = withTmpDir dest createSymlink' dest sympoint = withTmpDir dest
(\x -> createSymlink x sympoint) (\x -> createSymlink x sympoint)
renameFile' :: ByteString -> ByteString -> IO () renameFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE renameFile' #-}
renameFile' inputFileP outputFileP = renameFile' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP $ \i o -> do withTmpDir' inputFileP outputFileP $ \i o -> do
renameFile i o renameFile i o
renameFile o i renameFile o i
moveFile' :: ByteString -> ByteString -> CopyMode -> IO () moveFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE moveFile' #-} moveFile' inputFileP outputFileP =
moveFile' inputFileP outputFileP cm =
withTmpDir' inputFileP outputFileP $ \i o -> do withTmpDir' inputFileP outputFileP $ \i o -> do
moveFile i o cm moveFile i o
moveFile o i Strict moveFile o i
recreateSymlink' :: ByteString -> ByteString -> CopyMode -> IO () moveFileOverwrite' :: ByteString -> ByteString -> IO ()
{-# NOINLINE recreateSymlink' #-} moveFileOverwrite' inputFileP outputFileP =
recreateSymlink' inputFileP outputFileP cm = withTmpDir' inputFileP outputFileP $ \i o -> do
withTmpDir' inputFileP outputFileP (\p1 p2 -> recreateSymlink p1 p2 cm) moveFileOverwrite i o
moveFile o i
recreateSymlink' :: ByteString -> ByteString -> IO ()
recreateSymlink' inputFileP outputFileP =
withTmpDir' inputFileP outputFileP recreateSymlink
noWritableDirPerms :: ByteString -> IO () noWritableDirPerms :: ByteString -> IO ()
{-# NOINLINE noWritableDirPerms #-}
noWritableDirPerms path = withTmpDir path $ \p -> noWritableDirPerms path = withTmpDir path $ \p ->
setFileMode (P.fromAbs p) perms setFileMode (P.fromAbs p) perms
where where
@@ -233,58 +180,42 @@ noWritableDirPerms path = withTmpDir path $ \p ->
noPerms :: ByteString -> IO () noPerms :: ByteString -> IO ()
{-# NOINLINE noPerms #-}
noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode noPerms path = withTmpDir path $ \p -> setFileMode (P.fromAbs p) nullFileMode
normalDirPerms :: ByteString -> IO () normalDirPerms :: ByteString -> IO ()
{-# NOINLINE normalDirPerms #-}
normalDirPerms path = normalDirPerms path =
withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms withTmpDir path $ \p -> setFileMode (P.fromAbs p) newDirPerms
getFileType' :: ByteString -> IO FileType getFileType' :: ByteString -> IO FileType
{-# NOINLINE getFileType' #-}
getFileType' path = withTmpDir path getFileType getFileType' path = withTmpDir path getFileType
getDirsFiles' :: ByteString -> IO [P.Path P.Abs] getDirsFiles' :: ByteString -> IO [P.Path P.Abs]
{-# NOINLINE getDirsFiles' #-}
getDirsFiles' path = withTmpDir path getDirsFiles getDirsFiles' path = withTmpDir path getDirsFiles
deleteFile' :: ByteString -> IO () deleteFile' :: ByteString -> IO ()
{-# NOINLINE deleteFile' #-}
deleteFile' p = withTmpDir p deleteFile deleteFile' p = withTmpDir p deleteFile
deleteDir' :: ByteString -> IO () deleteDir' :: ByteString -> IO ()
{-# NOINLINE deleteDir' #-}
deleteDir' p = withTmpDir p deleteDir deleteDir' p = withTmpDir p deleteDir
deleteDirRecursive' :: ByteString -> IO () deleteDirRecursive' :: ByteString -> IO ()
{-# NOINLINE deleteDirRecursive' #-}
deleteDirRecursive' p = withTmpDir p deleteDirRecursive deleteDirRecursive' p = withTmpDir p deleteDirRecursive
canonicalizePath' :: ByteString -> IO (P.Path P.Abs) canonicalizePath' :: ByteString -> IO (P.Path P.Abs)
{-# NOINLINE canonicalizePath' #-}
canonicalizePath' p = withTmpDir p canonicalizePath canonicalizePath' p = withTmpDir p canonicalizePath
writeFile' :: ByteString -> ByteString -> IO () writeFile' :: ByteString -> ByteString -> IO ()
{-# NOINLINE writeFile' #-}
writeFile' ip bs = writeFile' ip bs =
withTmpDir ip $ \p -> do withTmpDir ip $ \p -> do
fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing fd <- SPI.openFd (P.fromAbs p) SPI.WriteOnly Nothing
SPI.defaultFileFlags SPI.defaultFileFlags
_ <- SPB.fdWrite fd bs SPB.fdWrite fd bs
SPI.closeFd fd SPI.closeFd fd
allDirectoryContents' :: ByteString -> IO [ByteString]
{-# NOINLINE allDirectoryContents' #-}
allDirectoryContents' ip =
withTmpDir ip $ \p -> DT.allDirectoryContents' (P.fromAbs p)