LIB: refactor FileOperation and related Errors
* move FileOperation/Copy/Move types to its own UtilTypes module * remove runFileOp, since it's hard to really do the correct thing here for all possible exceptions... instead, let the GUI logic handle this * introduce copyDirRecursiveOverwrite, copyFileOverwrite and easyCopyOverwrite * use our own throwSameFile on functions to distinguish between "same file" and "file already exists" * don't follow destination in copyFile* either * improve throwSameFile, by examining device and file ids * add isWritable * improve documentation * adjust and fix tests
This commit is contained in:
parent
d58fd6e6f0
commit
9c6cf51825
@ -27,6 +27,7 @@ library
|
||||
HSFM.FileSystem.Errors
|
||||
HSFM.FileSystem.FileOperations
|
||||
HSFM.FileSystem.FileType
|
||||
HSFM.FileSystem.UtilTypes
|
||||
HSFM.Utils.IO
|
||||
HSFM.Utils.MyPrelude
|
||||
|
||||
@ -120,7 +121,9 @@ Test-Suite spec
|
||||
Main-Is: Spec.hs
|
||||
other-modules:
|
||||
FileSystem.FileOperations.CopyDirRecursiveSpec
|
||||
FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec
|
||||
FileSystem.FileOperations.CopyFileSpec
|
||||
FileSystem.FileOperations.CopyFileOverwriteSpec
|
||||
FileSystem.FileOperations.CreateDirSpec
|
||||
FileSystem.FileOperations.CreateRegularFileSpec
|
||||
FileSystem.FileOperations.DeleteDirRecursiveSpec
|
||||
|
||||
@ -52,7 +52,11 @@ import System.IO.Error
|
||||
)
|
||||
|
||||
import qualified System.Posix.Directory.ByteString as PFD
|
||||
import System.Posix.FilePath
|
||||
import System.Posix.Files.ByteString
|
||||
(
|
||||
fileAccess
|
||||
, getFileStatus
|
||||
)
|
||||
import qualified System.Posix.Files.ByteString as PF
|
||||
|
||||
|
||||
@ -156,18 +160,28 @@ throwDirDoesNotExist fp =
|
||||
. P.fromAbs $ fp)
|
||||
|
||||
|
||||
throwSameFile :: Path Abs -- ^ will be canonicalized
|
||||
-> Path Abs -- ^ will be canonicalized
|
||||
-- |Uses `isSameFile` and throws `SameFile` if it returns True.
|
||||
throwSameFile :: Path Abs
|
||||
-> Path Abs
|
||||
-> IO ()
|
||||
throwSameFile fp1 fp2 = do
|
||||
fp1' <- fmap P.fromAbs $ P.canonicalizePath fp1
|
||||
-- TODO: clean this up... if canonicalizing fp2 fails we try to
|
||||
-- canonicalize `dirname fp2`
|
||||
fp2' <- catchIOError (fmap P.fromAbs $ P.canonicalizePath fp2)
|
||||
(\_ -> fmap P.fromAbs
|
||||
$ (\x -> maybe x (\y -> x P.</> y) $ P.basename fp2)
|
||||
<$> (P.canonicalizePath $ P.dirname fp2))
|
||||
when (equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')
|
||||
throwSameFile fp1 fp2 =
|
||||
whenM (sameFile fp1 fp2)
|
||||
(throw $ SameFile (P.fromAbs fp1) (P.fromAbs fp2))
|
||||
|
||||
|
||||
-- |Check if the files are the same by examining device and file id.
|
||||
-- This follows symbolic links.
|
||||
sameFile :: Path Abs -> Path Abs -> IO Bool
|
||||
sameFile fp1 fp2 =
|
||||
P.withAbsPath fp1 $ \fp1' -> P.withAbsPath fp2 $ \fp2' ->
|
||||
handleIOError (\_ -> return False) $ do
|
||||
fs1 <- getFileStatus fp1'
|
||||
fs2 <- getFileStatus fp2'
|
||||
|
||||
if ((PF.deviceID fs1, PF.fileID fs1) ==
|
||||
(PF.deviceID fs2, PF.fileID fs2))
|
||||
then return True
|
||||
else return False
|
||||
|
||||
|
||||
-- |Checks whether the destination directory is contained
|
||||
@ -179,14 +193,13 @@ throwDestinationInSource :: Path Abs -- ^ source dir
|
||||
-- must exist
|
||||
-> IO ()
|
||||
throwDestinationInSource source dest = do
|
||||
source' <- P.canonicalizePath source
|
||||
dest' <- (\x -> maybe x (\y -> x P.</> y) $ P.basename dest)
|
||||
<$> (P.canonicalizePath $ P.dirname dest)
|
||||
dids <- forM (P.getAllParents dest') $ \p -> do
|
||||
fs <- PF.getSymbolicLinkStatus (P.fromAbs p)
|
||||
return (PF.deviceID fs, PF.fileID fs)
|
||||
sid <- fmap (\x -> (PF.deviceID x, PF.fileID x))
|
||||
$ PF.getSymbolicLinkStatus (P.fromAbs source')
|
||||
$ PF.getFileStatus (P.fromAbs source)
|
||||
when (elem sid dids)
|
||||
(throw $ DestinationInSource (P.fromAbs dest)
|
||||
(P.fromAbs source))
|
||||
@ -210,6 +223,13 @@ doesDirectoryExist fp =
|
||||
return $ PF.isDirectory fs
|
||||
|
||||
|
||||
-- |Checks whether a file or folder is writable.
|
||||
isWritable :: Path Abs -> IO Bool
|
||||
isWritable fp =
|
||||
handleIOError (\_ -> return False) $
|
||||
fileAccess (P.fromAbs fp) False True False
|
||||
|
||||
|
||||
-- |Checks whether the directory at the given path exists and can be
|
||||
-- opened. This invokes `openDirStream` which follows symlinks.
|
||||
canOpenDirectory :: Path Abs -> IO Bool
|
||||
|
||||
@ -49,8 +49,7 @@ import Control.Exception
|
||||
)
|
||||
import Control.Monad
|
||||
(
|
||||
forM_
|
||||
, void
|
||||
void
|
||||
, when
|
||||
)
|
||||
import Data.ByteString
|
||||
@ -89,6 +88,10 @@ import Foreign.Ptr
|
||||
(
|
||||
Ptr
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import HPath
|
||||
(
|
||||
Path
|
||||
@ -97,7 +100,13 @@ import HPath
|
||||
)
|
||||
import qualified HPath as P
|
||||
import HSFM.FileSystem.Errors
|
||||
import HSFM.Utils.IO
|
||||
import Prelude hiding (readFile)
|
||||
import System.IO.Error
|
||||
(
|
||||
catchIOError
|
||||
, ioeGetErrorType
|
||||
)
|
||||
import System.Posix.ByteString
|
||||
(
|
||||
exclusive
|
||||
@ -128,6 +137,7 @@ import System.Posix.Files.ByteString
|
||||
, readSymbolicLink
|
||||
, removeLink
|
||||
, rename
|
||||
, setFileMode
|
||||
, unionFileModes
|
||||
)
|
||||
import qualified System.Posix.Files.ByteString as PF
|
||||
@ -150,33 +160,10 @@ import System.Posix.Types
|
||||
|
||||
|
||||
|
||||
-- TODO: file operations should be threaded and not block the UI
|
||||
-- TODO: make sure we do the right thing for BlockDev, CharDev etc...
|
||||
-- most operations are not implemented for these
|
||||
-- TODO: say which low-level syscalls are involved
|
||||
|
||||
|
||||
-- |Data type describing an actual file operation that can be
|
||||
-- carried out via `runFileOp`. Useful to build up a list of operations
|
||||
-- or delay operations.
|
||||
data FileOperation = FCopy Copy
|
||||
| FMove Move
|
||||
| FDelete [Path Abs]
|
||||
| FOpen (Path Abs)
|
||||
| FExecute (Path Abs) [ByteString]
|
||||
| None
|
||||
|
||||
|
||||
-- |Data type describing partial or complete file copy operation.
|
||||
-- CC stands for a complete operation and can be used for `runFileOp`.
|
||||
data Copy = PartialCopy [Path Abs]
|
||||
| Copy [Path Abs] (Path Abs)
|
||||
|
||||
|
||||
-- |Data type describing partial or complete file move operation.
|
||||
-- MC stands for a complete operation and can be used for `runFileOp`.
|
||||
data Move = PartialMove [Path Abs]
|
||||
| Move [Path Abs] (Path Abs)
|
||||
|
||||
|
||||
data FileType = Directory
|
||||
@ -190,33 +177,6 @@ data FileType = Directory
|
||||
|
||||
|
||||
|
||||
-- |Run a given FileOperation. If the FileOperation is partial, it will
|
||||
-- be returned. Returns `Nothing` on success.
|
||||
--
|
||||
-- Since file operations can be delayed, this is `Path Abs` based, not
|
||||
-- `File` based. This makes sure we don't have stale
|
||||
-- file information.
|
||||
runFileOp :: FileOperation -> IO (Maybe FileOperation)
|
||||
runFileOp fo' =
|
||||
case fo' of
|
||||
(FCopy (Copy froms to)) -> do
|
||||
forM_ froms $ \x -> do
|
||||
toname <- P.basename x
|
||||
easyCopy x (to P.</> toname)
|
||||
return Nothing
|
||||
(FCopy fo) -> return $ Just $ FCopy fo
|
||||
(FMove (Move froms to)) -> do
|
||||
forM_ froms $ \x -> do
|
||||
toname <- P.basename x
|
||||
moveFile x (to P.</> toname)
|
||||
return Nothing
|
||||
(FMove fo) -> return $ Just $ FMove fo
|
||||
(FDelete fps) ->
|
||||
mapM_ easyDelete fps >> return Nothing
|
||||
(FOpen fp) -> openFile fp >> return Nothing
|
||||
(FExecute fp args) -> executeFile fp args >> return Nothing
|
||||
_ -> return Nothing
|
||||
|
||||
|
||||
|
||||
--------------------
|
||||
@ -244,15 +204,16 @@ runFileOp fo' =
|
||||
-- - `PermissionDenied` if source directory can't be opened
|
||||
-- - `InvalidArgument` if source directory is wrong type (symlink)
|
||||
-- - `InvalidArgument` if source directory is wrong type (regular file)
|
||||
-- - `AlreadyExists` if source and destination are the same directory
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
-- - `AlreadyExists` if destination already exists
|
||||
-- - `DestinationInSource` if destination is contained in source
|
||||
-- - `DestinationInSource` if destination is contained in source (`FmIOException`)
|
||||
copyDirRecursive :: Path Abs -- ^ source dir
|
||||
-> Path Abs -- ^ full destination
|
||||
-> IO ()
|
||||
copyDirRecursive fromp destdirp
|
||||
= do
|
||||
-- for performance, sanity checks are only done for the top dir
|
||||
throwSameFile fromp destdirp
|
||||
throwDestinationInSource fromp destdirp
|
||||
go fromp destdirp
|
||||
where
|
||||
@ -275,6 +236,51 @@ copyDirRecursive fromp destdirp
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
-- |Like `copyDirRecursive` except it overwrites contents of directories
|
||||
-- if any.
|
||||
--
|
||||
-- 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 (`FmIOException`)
|
||||
-- - `DestinationInSource` if destination is contained in source (`FmIOException`)
|
||||
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 (P.fromAbs fromp')
|
||||
catchIOError (createDirectory (P.fromAbs destdirp') fmode') $ \e ->
|
||||
case ioeGetErrorType e of
|
||||
AlreadyExists -> setFileMode (P.fromAbs destdirp') fmode'
|
||||
_ -> ioError e
|
||||
|
||||
for_ contents $ \f -> do
|
||||
ftype <- getFileType f
|
||||
newdest <- (destdirp' P.</>) <$> P.basename f
|
||||
case ftype of
|
||||
SymbolicLink -> whenM (doesFileExist newdest) (deleteFile newdest)
|
||||
>> recreateSymlink f newdest
|
||||
Directory -> go f newdest
|
||||
RegularFile -> copyFileOverwrite f newdest
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
|
||||
-- |Recreate a symlink.
|
||||
--
|
||||
@ -285,7 +291,7 @@ copyDirRecursive fromp destdirp
|
||||
-- - `PermissionDenied` if output directory cannot be written to
|
||||
-- - `PermissionDenied` if source directory cannot be opened
|
||||
-- - `AlreadyExists` if destination file already exists
|
||||
-- - `AlreadyExists` if destination and source are the same file
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `symlink`
|
||||
recreateSymlink :: Path Abs -- ^ the old symlink file
|
||||
@ -293,11 +299,12 @@ recreateSymlink :: Path Abs -- ^ the old symlink file
|
||||
-> IO ()
|
||||
recreateSymlink symsource newsym
|
||||
= do
|
||||
throwSameFile symsource newsym
|
||||
sympoint <- readSymbolicLink (P.fromAbs symsource)
|
||||
createSymbolicLink sympoint (P.fromAbs newsym)
|
||||
|
||||
|
||||
-- |Copies the given regular file to the given dir with the given filename.
|
||||
-- |Copies the given regular file to the given destination.
|
||||
-- Neither follows symbolic links, nor accepts them.
|
||||
-- For "copying" symbolic links, use `recreateSymlink` instead.
|
||||
--
|
||||
@ -308,19 +315,29 @@ recreateSymlink symsource newsym
|
||||
-- - `PermissionDenied` if source directory can't be opened
|
||||
-- - `InvalidArgument` if source file is wrong type (symlink)
|
||||
-- - `InvalidArgument` if source file is wrong type (directory)
|
||||
-- - `AlreadyExists` if source and destination are the same file
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
-- - `AlreadyExists` if destination already exists
|
||||
--
|
||||
-- Note: calls `sendfile`
|
||||
copyFile :: Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
copyFile from to = _copyFile SPI.defaultFileFlags { exclusive = True } from to
|
||||
copyFile from to = do
|
||||
throwSameFile from to
|
||||
_copyFile [SPDF.oNofollow]
|
||||
[SPDF.oNofollow, SPDF.oExcl]
|
||||
from to
|
||||
|
||||
|
||||
-- |Like `copyFile` except it overwrites the destination if it already exists.
|
||||
-- |Like `copyFile` except it overwrites the destination if it already
|
||||
-- exists.
|
||||
-- This also works if source and destination are the same file.
|
||||
--
|
||||
-- Safety/reliability concerns:
|
||||
--
|
||||
-- * not atomic
|
||||
-- * falls back to delete-copy method with explicit checks
|
||||
--
|
||||
-- Throws:
|
||||
--
|
||||
-- - `NoSuchThing` if source file does not exist
|
||||
@ -328,19 +345,35 @@ copyFile from to = _copyFile SPI.defaultFileFlags { exclusive = True } from to
|
||||
-- - `PermissionDenied` if source directory can't be opened
|
||||
-- - `InvalidArgument` if source file is wrong type (symlink)
|
||||
-- - `InvalidArgument` if source file is wrong type (directory)
|
||||
-- - `SameFile` if source and destination are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `sendfile`
|
||||
copyFileOverwrite :: Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
copyFileOverwrite from to = _copyFile SPI.defaultFileFlags { exclusive = False } from to
|
||||
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 (P.dirname to)
|
||||
if exists && writable
|
||||
then deleteFile to >> copyFile from to
|
||||
else ioError e
|
||||
_ -> ioError e
|
||||
|
||||
|
||||
_copyFile :: SPI.OpenFileFlags
|
||||
_copyFile :: [SPDF.Flags]
|
||||
-> [SPDF.Flags]
|
||||
-> Path Abs -- ^ source file
|
||||
-> Path Abs -- ^ destination file
|
||||
-> IO ()
|
||||
_copyFile off from to
|
||||
_copyFile sflags dflags from to
|
||||
=
|
||||
-- from sendfile(2) manpage:
|
||||
-- Applications may wish to fall back to read(2)/write(2) in the case
|
||||
@ -352,24 +385,26 @@ _copyFile off from to
|
||||
where
|
||||
-- this is low-level stuff utilizing sendfile(2) for speed
|
||||
sendFileCopy source dest =
|
||||
bracket (SPDT.openFd source SPI.ReadOnly [SPDF.oNofollow] Nothing)
|
||||
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
|
||||
SPI.closeFd
|
||||
$ \sfd -> do
|
||||
fileM <- System.Posix.Files.ByteString.fileMode
|
||||
<$> getFdStatus sfd
|
||||
bracketeer (SPI.openFd dest SPI.WriteOnly (Just fileM) off)
|
||||
bracketeer (SPDT.openFd dest SPI.WriteOnly
|
||||
dflags $ Just fileM)
|
||||
SPI.closeFd
|
||||
(\fd -> SPI.closeFd fd >> deleteFile to)
|
||||
$ \dfd -> sendfileFd dfd sfd EntireFile
|
||||
-- low-level copy operation utilizing read(2)/write(2)
|
||||
-- in case `sendFileCopy` fails/is unsupported
|
||||
fallbackCopy source dest =
|
||||
bracket (SPDT.openFd source SPI.ReadOnly [SPDF.oNofollow] Nothing)
|
||||
bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing)
|
||||
SPI.closeFd
|
||||
$ \sfd -> do
|
||||
fileM <- System.Posix.Files.ByteString.fileMode
|
||||
<$> getFdStatus sfd
|
||||
bracketeer (SPI.openFd dest SPI.WriteOnly (Just fileM) off)
|
||||
bracketeer (SPDT.openFd dest SPI.WriteOnly
|
||||
dflags $ Just fileM)
|
||||
SPI.closeFd
|
||||
(\fd -> SPI.closeFd fd >> deleteFile to)
|
||||
$ \dfd -> allocaBytes (fromIntegral bufSize) $ \buf ->
|
||||
@ -408,6 +443,23 @@ easyCopy from to = do
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
|
||||
-- |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.
|
||||
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
|
||||
_ -> ioError $ userError $ "No idea what to do with the" ++
|
||||
"given filetype: " ++ show ftype
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@ -576,7 +628,7 @@ createDir dest = createDirectory (P.fromAbs dest) newDirPerms
|
||||
-- - `UnsupportedOperation` if source and destination are on different devices
|
||||
-- - `FileDoesExist` if destination file already exists
|
||||
-- - `DirDoesExist` if destination directory already exists
|
||||
-- - `SameFile` if destination and source are the same file
|
||||
-- - `SameFile` if destination and source are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `rename` (but does not allow to rename over existing files)
|
||||
renameFile :: Path Abs -> Path Abs -> IO ()
|
||||
@ -603,13 +655,14 @@ renameFile fromf tof = do
|
||||
-- - `PermissionDenied` if source directory cannot be opened
|
||||
-- - `FileDoesExist` if destination file already exists
|
||||
-- - `DirDoesExist` if destination directory already exists
|
||||
-- - `SameFile` if destination and source are the same file
|
||||
-- - `SameFile` if destination and source are the same file (`FmIOException`)
|
||||
--
|
||||
-- Note: calls `rename` (but does not allow to rename over existing files)
|
||||
moveFile :: Path Abs -- ^ file to move
|
||||
-> Path Abs -- ^ destination
|
||||
-> IO ()
|
||||
moveFile from to =
|
||||
moveFile from to = do
|
||||
throwSameFile from to
|
||||
catchErrno [eXDEV] (renameFile from to) $ do
|
||||
easyCopy from to
|
||||
easyDelete from
|
||||
|
||||
84
src/HSFM/FileSystem/UtilTypes.hs
Normal file
84
src/HSFM/FileSystem/UtilTypes.hs
Normal file
@ -0,0 +1,84 @@
|
||||
{--
|
||||
HSFM, a filemanager written in Haskell.
|
||||
Copyright (C) 2016 Julian Ospald
|
||||
|
||||
This program is free software; you can redistribute it and/or
|
||||
modify it under the terms of the GNU General Public License
|
||||
version 2 as published by the Free Software Foundation.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
GNU General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU General Public License
|
||||
along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
|
||||
--}
|
||||
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# OPTIONS_HADDOCK ignore-exports #-}
|
||||
|
||||
|
||||
-- |This module provides high-level IO related file operations like
|
||||
-- copy, delete, move and so on. It only operates on `Path Abs` which
|
||||
-- guarantees us well-typed paths which are absolute.
|
||||
--
|
||||
-- Some functions are just path-safe wrappers around
|
||||
-- unix functions, others have stricter exception handling
|
||||
-- and some implement functionality that doesn't have a unix
|
||||
-- counterpart (like `copyDirRecursive`).
|
||||
--
|
||||
-- Some of these operations are due to their nature not _atomic_, which
|
||||
-- means they may do multiple syscalls which form one context. Some
|
||||
-- of them also have to examine the filetypes explicitly before the
|
||||
-- syscalls, so a reasonable decision can be made. That means
|
||||
-- the result is undefined if another process changes that context
|
||||
-- while the non-atomic operation is still happening. However, where
|
||||
-- possible, as few syscalls as possible are used and the underlying
|
||||
-- exception handling is kept.
|
||||
module HSFM.FileSystem.UtilTypes where
|
||||
|
||||
|
||||
import Data.ByteString
|
||||
(
|
||||
ByteString
|
||||
)
|
||||
import HPath
|
||||
(
|
||||
Path
|
||||
, Abs
|
||||
, Fn
|
||||
)
|
||||
|
||||
|
||||
-- |Data type describing file operations.
|
||||
-- Useful to build up a list of operations or delay operations.
|
||||
data FileOperation = FCopy Copy
|
||||
| FMove Move
|
||||
| FDelete [Path Abs]
|
||||
| FOpen (Path Abs)
|
||||
| FExecute (Path Abs) [ByteString]
|
||||
| None
|
||||
|
||||
|
||||
-- |Data type describing partial or complete file copy operation.
|
||||
data Copy = PartialCopy [Path Abs] -- source files
|
||||
| Copy [Path Abs] -- source files
|
||||
(Path Abs) -- base destination directory
|
||||
|
||||
|
||||
-- |Data type describing partial or complete file move operation.
|
||||
data Move = PartialMove [Path Abs] -- source files
|
||||
| Move [Path Abs] -- source files
|
||||
(Path Abs) -- base destination directory
|
||||
|
||||
|
||||
-- |Collision modes that describe the behavior in case a file collision
|
||||
-- happens.
|
||||
data FCollisonMode = Strict -- ^ fail if the target already exists
|
||||
| Overwrite
|
||||
| OverwriteAll
|
||||
| Skip
|
||||
| Rename (Path Fn)
|
||||
|
||||
@ -0,0 +1,99 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
)
|
||||
import GHC.IO.Exception
|
||||
(
|
||||
IOErrorType(..)
|
||||
)
|
||||
import System.Exit
|
||||
import System.Process
|
||||
import Utils
|
||||
|
||||
|
||||
|
||||
copyDirRecursiveOverwriteSpec :: Spec
|
||||
copyDirRecursiveOverwriteSpec =
|
||||
describe "HSFM.FileSystem.FileOperations.copyDirRecursiveOverwrite" $ do
|
||||
|
||||
-- successes --
|
||||
it "copyDirRecursiveOverwrite, all fine" $ do
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
|
||||
removeDirIfExists "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
|
||||
|
||||
it "copyDirRecursiveOverwrite, all fine and compare" $ do
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
|
||||
(system $ "diff -r --no-dereference "
|
||||
++ "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir" ++ " "
|
||||
++ "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir")
|
||||
`shouldReturn` ExitSuccess
|
||||
removeDirIfExists "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
|
||||
|
||||
it "copyDirRecursiveOverwrite, destination dir already exists" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/alreadyExistsD"
|
||||
|
||||
-- posix failures --
|
||||
it "copyDirRecursiveOverwrite, source directory does not exist" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/doesNotExist"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == NoSuchThing)
|
||||
|
||||
it "copyDirRecursiveOverwrite, no write permission on output dir" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noWritePerm/foo"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursiveOverwrite, cannot open output dir" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms/foo"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursiveOverwrite, cannot open source dir" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/foo"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == PermissionDenied)
|
||||
|
||||
it "copyDirRecursiveOverwrite, destination already exists and is a file" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/alreadyExists"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursiveOverwrite, wrong input (regular file)" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/wrongInput"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyDirRecursiveOverwrite, wrong input (symlink to directory)" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/wrongInputSymL"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/outputDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InvalidArgument)
|
||||
|
||||
-- custom failures
|
||||
it "copyDirRecursiveOverwrite, destination in source" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir/foo"
|
||||
`shouldThrow`
|
||||
isDestinationInSource
|
||||
|
||||
it "copyDirRecursiveOverwrite, destination and source same directory" $
|
||||
copyDirRecursiveOverwrite' "test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/inputDir"
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
@ -75,12 +75,6 @@ copyDirRecursiveSpec =
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyDirRecursive, destination and source same directory" $
|
||||
copyDirRecursive' "test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyDirRecursive, wrong input (regular file)" $
|
||||
copyDirRecursive' "test/FileSystem/FileOperations/copyDirRecursiveSpec/wrongInput"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveSpec/outputDir"
|
||||
@ -100,3 +94,8 @@ copyDirRecursiveSpec =
|
||||
`shouldThrow`
|
||||
isDestinationInSource
|
||||
|
||||
it "copyDirRecursive, destination and source same directory" $
|
||||
copyDirRecursive' "test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir"
|
||||
"test/FileSystem/FileOperations/copyDirRecursiveSpec/inputDir"
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
@ -4,6 +4,7 @@ module FileSystem.FileOperations.CopyFileOverwriteSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
@ -32,10 +33,6 @@ copyFileOverwriteSpec =
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/alreadyExists"
|
||||
|
||||
it "copyFileOverwrite, output and input are same file" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
|
||||
it "copyFileOverwrite, and compare" $ do
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputFile"
|
||||
@ -87,3 +84,8 @@ copyFileOverwriteSpec =
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
-- custom failures --
|
||||
it "copyFileOverwrite, output and input are same file" $
|
||||
copyFileOverwrite' "test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileOverwriteSpec/inputFile"
|
||||
`shouldThrow` isSameFile
|
||||
|
||||
@ -4,6 +4,7 @@ module FileSystem.FileOperations.CopyFileSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
@ -73,12 +74,6 @@ copyFileSpec =
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == InappropriateType)
|
||||
|
||||
it "copyFile, output and input are same file" $
|
||||
copyFile' "test/FileSystem/FileOperations/copyFileSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileSpec/inputFile"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
it "copyFile, output file already exists" $
|
||||
copyFile' "test/FileSystem/FileOperations/copyFileSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileSpec/alreadyExists"
|
||||
@ -91,3 +86,9 @@ copyFileSpec =
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
-- custom failures --
|
||||
it "copyFile, output and input are same file" $
|
||||
copyFile' "test/FileSystem/FileOperations/copyFileSpec/inputFile"
|
||||
"test/FileSystem/FileOperations/copyFileSpec/inputFile"
|
||||
`shouldThrow`
|
||||
isSameFile
|
||||
|
||||
@ -4,6 +4,7 @@ module FileSystem.FileOperations.RecreateSymlinkSpec where
|
||||
|
||||
|
||||
import Test.Hspec
|
||||
import HSFM.FileSystem.Errors
|
||||
import System.IO.Error
|
||||
(
|
||||
ioeGetErrorType
|
||||
@ -73,9 +74,10 @@ recreateSymlinkSpec =
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
|
||||
-- custom failures --
|
||||
it "recreateSymLink, source and destination are the same file" $
|
||||
recreateSymlink' "test/FileSystem/FileOperations/recreateSymlinkSpec/myFileL"
|
||||
"test/FileSystem/FileOperations/recreateSymlinkSpec/myFileL"
|
||||
`shouldThrow`
|
||||
(\e -> ioeGetErrorType e == AlreadyExists)
|
||||
isSameFile
|
||||
|
||||
|
||||
@ -0,0 +1,8 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@ -0,0 +1 @@
|
||||
dadasasddas
|
||||
@ -0,0 +1,4 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@ -0,0 +1,8 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@ -0,0 +1 @@
|
||||
dadasasddas
|
||||
@ -0,0 +1,4 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@ -0,0 +1,8 @@
|
||||
dadasasddas
|
||||
sda
|
||||
|
||||
!!1
|
||||
sda
|
||||
|
||||
|
||||
11
|
||||
@ -0,0 +1 @@
|
||||
dadasasddas
|
||||
@ -0,0 +1,4 @@
|
||||
dadasasddas
|
||||
das
|
||||
sda
|
||||
sda
|
||||
@ -0,0 +1 @@
|
||||
inputDir/
|
||||
@ -1,4 +1,16 @@
|
||||
abc
|
||||
def
|
||||
adaöölsdaöl
|
||||
dsalö
|
||||
ölsda
|
||||
ääödsf
|
||||
äsdfä
|
||||
öä453
|
||||
öä
|
||||
435
|
||||
ä45343
|
||||
5
|
||||
453
|
||||
453453453
|
||||
das
|
||||
asd
|
||||
das
|
||||
|
||||
dsadasdsa
|
||||
|
||||
@ -3,6 +3,7 @@
|
||||
import Test.Hspec
|
||||
|
||||
import FileSystem.FileOperations.CopyDirRecursiveSpec
|
||||
import FileSystem.FileOperations.CopyDirRecursiveOverwriteSpec
|
||||
import FileSystem.FileOperations.CopyFileOverwriteSpec
|
||||
import FileSystem.FileOperations.CopyFileSpec
|
||||
import FileSystem.FileOperations.CreateDirSpec
|
||||
@ -26,6 +27,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
|
||||
let tests = [copyFileSpec
|
||||
,copyFileOverwriteSpec
|
||||
,copyDirRecursiveSpec
|
||||
,copyDirRecursiveOverwriteSpec
|
||||
,createDirSpec
|
||||
,createRegularFileSpec
|
||||
,renameFileSpec
|
||||
@ -48,6 +50,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
|
||||
noWriteDirs = ["test/FileSystem/FileOperations/copyFileSpec/outputDirNoWrite"
|
||||
,"test/FileSystem/FileOperations/copyFileOverwriteSpec/outputDirNoWrite"
|
||||
,"test/FileSystem/FileOperations/copyDirRecursiveSpec/noWritePerm"
|
||||
,"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noWritePerm"
|
||||
,"test/FileSystem/FileOperations/createDirSpec/noWritePerms"
|
||||
,"test/FileSystem/FileOperations/createRegularFileSpec/noWritePerms"
|
||||
,"test/FileSystem/FileOperations/renameFileSpec/noWritePerm"
|
||||
@ -57,6 +60,7 @@ main = hspec $ before_ fixPermissions $ after_ revertPermissions $ do
|
||||
noPermsDirs = ["test/FileSystem/FileOperations/copyFileSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/copyFileOverwriteSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/copyDirRecursiveSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/copyDirRecursiveOverwriteSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/createDirSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/createRegularFileSpec/noPerms"
|
||||
,"test/FileSystem/FileOperations/renameFileSpec/noPerms"
|
||||
|
||||
@ -82,6 +82,11 @@ copyDirRecursive' inputDirP outputDirP =
|
||||
withPwd' inputDirP outputDirP copyDirRecursive
|
||||
|
||||
|
||||
copyDirRecursiveOverwrite' :: ByteString -> ByteString -> IO ()
|
||||
copyDirRecursiveOverwrite' inputDirP outputDirP =
|
||||
withPwd' inputDirP outputDirP copyDirRecursiveOverwrite
|
||||
|
||||
|
||||
createDir' :: ByteString -> IO ()
|
||||
createDir' dest = withPwd dest createDir
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user