* remove some obsolete functions and error types from HPath.IO.Errors that are completely unused * reworked the RecursiveFailure type to contain more information, so we can use it to programmatically make useful choices without examining the weakly types IO error attributes (like 'ioGetFileName')tags/0.8.1
@@ -226,7 +226,7 @@ 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 | |||
@@ -322,41 +322,56 @@ copyDirRecursive fromp destdirp cm rm | |||
unless (null collectedExceptions) | |||
(throwIO . RecursiveFailure $ collectedExceptions) | |||
where | |||
go :: IORef [IOException] -> Path Abs -> Path Abs -> IO () | |||
go :: IORef [(RecursiveFailureHint, IOException)] | |||
-> Path Abs -> Path Abs -> IO () | |||
go ce fromp' destdirp' = do | |||
-- order is important here, so we don't get empty directories | |||
-- NOTE: order is important here, so we don't get empty directories | |||
-- on failure | |||
contents <- handleIOE ce [] $ do | |||
-- get the contents of the source dir | |||
contents <- handleIOE (ReadContentsFailed fromp' destdirp') ce [] $ do | |||
contents <- getDirsFiles fromp' | |||
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp') | |||
case cm of | |||
Strict -> createDirectory (fromAbs destdirp') fmode' | |||
Overwrite -> catchIOError (createDirectory (fromAbs destdirp') | |||
fmode') | |||
$ \e -> | |||
case ioeGetErrorType e of | |||
AlreadyExists -> setFileMode (fromAbs destdirp') | |||
fmode' | |||
_ -> ioError e | |||
return contents | |||
-- we can't use `easyCopy` here, because we want to call `go` | |||
-- create the destination dir and | |||
-- only return contents if we succeed | |||
handleIOE (CreateDirFailed fromp' destdirp') ce [] $ do | |||
fmode' <- PF.fileMode <$> PF.getSymbolicLinkStatus (fromAbs fromp') | |||
case cm of | |||
Strict -> createDirectory (fromAbs destdirp') fmode' | |||
Overwrite -> catchIOError (createDirectory (fromAbs destdirp') | |||
fmode') | |||
$ \e -> | |||
case ioeGetErrorType e of | |||
AlreadyExists -> setFileMode (fromAbs destdirp') | |||
fmode' | |||
_ -> ioError e | |||
return contents | |||
-- NOTE: we can't use `easyCopy` here, because we want to call `go` | |||
-- recursively to skip the top-level sanity checks | |||
-- if reading the contents and creating the destination dir worked, | |||
-- then copy the contents to the destination too | |||
for_ contents $ \f -> do | |||
ftype <- getFileType f | |||
newdest <- (destdirp' </>) <$> basename f | |||
case ftype of | |||
SymbolicLink -> handleIOE ce () | |||
SymbolicLink -> handleIOE (RecreateSymlinkFailed f newdest) ce () | |||
$ recreateSymlink f newdest cm | |||
Directory -> go ce f newdest | |||
RegularFile -> handleIOE ce () $ copyFile f newdest cm | |||
RegularFile -> handleIOE (CopyFileFailed f newdest) ce () | |||
$ copyFile f newdest cm | |||
_ -> return () | |||
handleIOE :: IORef [IOException] -> a -> IO a -> IO a | |||
handleIOE ce def = case rm of | |||
FailEarly -> handleIOError throwIO | |||
CollectFailures -> handleIOError (\e -> modifyIORef ce (e:) | |||
-- helper to handle errors for both RecursiveErrorModes and return a | |||
-- default value | |||
handleIOE :: RecursiveFailureHint | |||
-> IORef [(RecursiveFailureHint, IOException)] | |||
-> a -> IO a -> IO a | |||
handleIOE hint ce def = case rm of | |||
FailEarly -> handleIOError throwIO | |||
CollectFailures -> handleIOError (\e -> modifyIORef ce ((hint, e):) | |||
>> return def) | |||
@@ -379,7 +394,7 @@ copyDirRecursive fromp destdirp cm rm | |||
-- | |||
-- Throws in `Strict` mode only: | |||
-- | |||
-- - `AlreadyExists` if destination already exists | |||
-- | |||
-- Throws in `Overwrite` mode only: | |||
-- | |||
@@ -512,8 +527,8 @@ _copyFile sflags dflags from to | |||
if size == 0 | |||
then return $ fromIntegral totalsize | |||
else do rsize <- SPB.fdWriteBuf dfd buf size | |||
when (rsize /= size) (throwIO . CopyFailed | |||
$ "wrong size!") | |||
when (rsize /= size) (ioError $ userError | |||
"wrong size!") | |||
write' sfd dfd buf (totalsize + fromIntegral size) | |||
@@ -667,7 +682,7 @@ executeFile fp args | |||
-- Throws: | |||
-- | |||
-- - `PermissionDenied` if output directory cannot be written to | |||
-- - `AlreadyExists` if destination already exists | |||
-- - `NoSuchThing` if any of the parent components of the path | |||
-- do not exist | |||
createRegularFile :: FileMode -> Path Abs -> IO () | |||
@@ -683,7 +698,7 @@ createRegularFile fm dest = | |||
-- Throws: | |||
-- | |||
-- - `PermissionDenied` if output directory cannot be written to | |||
-- - `AlreadyExists` if destination already exists | |||
-- - `NoSuchThing` if any of the parent components of the path | |||
-- do not exist | |||
createDir :: FileMode -> Path Abs -> IO () | |||
@@ -758,10 +773,7 @@ createSymlink dest sympoint | |||
-- - `PermissionDenied` if source directory cannot be opened | |||
-- - `UnsupportedOperation` if source and destination are on different | |||
-- devices | |||
-- - `AlreadyExists` if destination already exists | |||
-- - `SameFile` if destination and source are the same file | |||
-- (`HPathIOException`) | |||
-- | |||
@@ -800,9 +812,7 @@ renameFile fromf tof = do | |||
-- | |||
-- Throws in `Strict` mode only: | |||
-- | |||
-- - `AlreadyExists` if destination already exists | |||
-- | |||
-- Note: calls `rename` (but does not allow to rename over existing files) | |||
moveFile :: Path Abs -- ^ file to move | |||
@@ -9,31 +9,26 @@ | |||
-- | |||
-- Provides error handling. | |||
{-# LANGUAGE DeriveDataTypeable #-} | |||
{-# LANGUAGE ScopedTypeVariables #-} | |||
module HPath.IO.Errors | |||
( | |||
-- * Types | |||
HPathIOException(..) | |||
, RecursiveFailureHint(..) | |||
-- * Exception identifiers | |||
, isFileDoesNotExist | |||
, isDirDoesNotExist | |||
, isSameFile | |||
, isDestinationInSource | |||
, isFileDoesExist | |||
, isDirDoesExist | |||
, isInvalidOperation | |||
, isCan'tOpenDirectory | |||
, isCopyFailed | |||
, isRecursiveFailure | |||
, isReadContentsFailed | |||
, isCreateDirFailed | |||
, isCopyFileFailed | |||
, isRecreateSymlinkFailed | |||
-- * Path based functions | |||
, throwFileDoesExist | |||
, throwDirDoesExist | |||
, throwFileDoesNotExist | |||
, throwDirDoesNotExist | |||
, throwSameFile | |||
, sameFile | |||
, throwDestinationInSource | |||
@@ -41,7 +36,6 @@ module HPath.IO.Errors | |||
, doesDirectoryExist | |||
, isWritable | |||
, canOpenDirectory | |||
, throwCantOpenDirectory | |||
-- * Error handling functions | |||
, catchErrno | |||
@@ -66,7 +60,6 @@ import Control.Monad | |||
import Control.Monad.IfElse | |||
( | |||
whenM | |||
, unlessM | |||
) | |||
import Data.ByteString | |||
( | |||
@@ -76,7 +69,6 @@ import Data.ByteString.UTF8 | |||
( | |||
toString | |||
) | |||
import Data.Typeable | |||
import Foreign.C.Error | |||
( | |||
getErrno | |||
@@ -93,8 +85,10 @@ import {-# SOURCE #-} HPath.IO | |||
) | |||
import System.IO.Error | |||
( | |||
catchIOError | |||
alreadyExistsErrorType | |||
, catchIOError | |||
, ioeGetErrorType | |||
, mkIOError | |||
) | |||
import qualified System.Posix.Directory.ByteString as PFD | |||
@@ -106,55 +100,34 @@ import System.Posix.Files.ByteString | |||
import qualified System.Posix.Files.ByteString as PF | |||
data HPathIOException = FileDoesNotExist ByteString | |||
| DirDoesNotExist ByteString | |||
| SameFile ByteString ByteString | |||
-- |Additional generic IO exceptions that the posix functions | |||
-- do not provide. | |||
data HPathIOException = SameFile ByteString ByteString | |||
| DestinationInSource ByteString ByteString | |||
| FileDoesExist ByteString | |||
| DirDoesExist ByteString | |||
| InvalidOperation String | |||
| Can'tOpenDirectory ByteString | |||
| CopyFailed String | |||
| RecursiveFailure [IOException] | |||
deriving (Typeable, Eq) | |||
instance Show HPathIOException where | |||
show (FileDoesNotExist fp) = "File does not exist:" ++ toString fp | |||
show (DirDoesNotExist fp) = "Directory does not exist: " | |||
++ toString fp | |||
show (SameFile fp1 fp2) = toString fp1 | |||
++ " and " ++ toString fp2 | |||
++ " are the same file!" | |||
show (DestinationInSource fp1 fp2) = toString fp1 | |||
++ " is contained in " | |||
++ toString fp2 | |||
show (FileDoesExist fp) = "File does exist: " ++ toString fp | |||
show (DirDoesExist fp) = "Directory does exist: " ++ toString fp | |||
show (InvalidOperation str) = "Invalid operation: " ++ str | |||
show (Can'tOpenDirectory fp) = "Can't open directory: " | |||
++ toString fp | |||
show (CopyFailed str) = "Copying failed: " ++ str | |||
show (RecursiveFailure exs) = "Recursive operation failed: " | |||
++ show exs | |||
| RecursiveFailure [(RecursiveFailureHint, IOException)] | |||
deriving (Eq, Show) | |||
toConstr :: HPathIOException -> String | |||
toConstr FileDoesNotExist {} = "FileDoesNotExist" | |||
toConstr DirDoesNotExist {} = "DirDoesNotExist" | |||
toConstr SameFile {} = "SameFile" | |||
toConstr DestinationInSource {} = "DestinationInSource" | |||
toConstr FileDoesExist {} = "FileDoesExist" | |||
toConstr DirDoesExist {} = "DirDoesExist" | |||
toConstr InvalidOperation {} = "InvalidOperation" | |||
toConstr Can'tOpenDirectory {} = "Can'tOpenDirectory" | |||
toConstr CopyFailed {} = "CopyFailed" | |||
toConstr RecursiveFailure {} = "RecursiveFailure" | |||
-- |A type for giving failure hints on recursive failure, which allows | |||
-- to programmatically make choices without examining | |||
-- the weakly typed I/O error attributes (like `ioeGetFileName`). | |||
-- | |||
-- The first argument to the data constructor is always the | |||
-- source and the second the destination. | |||
data RecursiveFailureHint = ReadContentsFailed (Path Abs) (Path Abs) | |||
| CreateDirFailed (Path Abs) (Path Abs) | |||
| CopyFileFailed (Path Abs) (Path Abs) | |||
| RecreateSymlinkFailed (Path Abs) (Path Abs) | |||
deriving (Eq, Show) | |||
instance Exception HPathIOException | |||
instance Exception HPathIOException | |||
toConstr :: HPathIOException -> String | |||
toConstr SameFile {} = "SameFile" | |||
toConstr DestinationInSource {} = "DestinationInSource" | |||
toConstr RecursiveFailure {} = "RecursiveFailure" | |||
@@ -164,47 +137,54 @@ instance Exception HPathIOException | |||
--[ Exception identifiers ]-- | |||
----------------------------- | |||
isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed, isRecursiveFailure :: HPathIOException -> Bool | |||
isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{} | |||
isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{} | |||
isSameFile, isDestinationInSource, isRecursiveFailure :: HPathIOException -> Bool | |||
isSameFile ex = toConstr (ex :: HPathIOException) == toConstr SameFile{} | |||
isDestinationInSource ex = toConstr (ex :: HPathIOException) == toConstr DestinationInSource{} | |||
isFileDoesExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesExist{} | |||
isDirDoesExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesExist{} | |||
isInvalidOperation ex = toConstr (ex :: HPathIOException) == toConstr InvalidOperation{} | |||
isCan'tOpenDirectory ex = toConstr (ex :: HPathIOException) == toConstr Can'tOpenDirectory{} | |||
isCopyFailed ex = toConstr (ex :: HPathIOException) == toConstr CopyFailed{} | |||
isRecursiveFailure ex = toConstr (ex :: HPathIOException) == toConstr RecursiveFailure{} | |||
isReadContentsFailed, isCreateDirFailed, isCopyFileFailed, isRecreateSymlinkFailed ::RecursiveFailureHint -> Bool | |||
isReadContentsFailed ReadContentsFailed{} = True | |||
isReadContentsFailed _ = False | |||
isCreateDirFailed CreateDirFailed{} = True | |||
isCreateDirFailed _ = False | |||
isCopyFileFailed CopyFileFailed{} = True | |||
isCopyFileFailed _ = False | |||
isRecreateSymlinkFailed RecreateSymlinkFailed{} = True | |||
isRecreateSymlinkFailed _ = False | |||
---------------------------- | |||
--[ Path based functions ]-- | |||
---------------------------- | |||
-- |Throws `AlreadyExists` `IOError` if file exists. | |||
throwFileDoesExist :: Path Abs -> IO () | |||
throwFileDoesExist fp = | |||
whenM (doesFileExist fp) (throwIO . FileDoesExist | |||
. fromAbs $ fp) | |||
whenM (doesFileExist fp) | |||
(ioError . mkIOError | |||
alreadyExistsErrorType | |||
"File already exists" | |||
Nothing | |||
$ (Just (toString $ fromAbs fp)) | |||
) | |||
-- |Throws `AlreadyExists` `IOError` if directory exists. | |||
throwDirDoesExist :: Path Abs -> IO () | |||
throwDirDoesExist fp = | |||
whenM (doesDirectoryExist fp) (throwIO . DirDoesExist | |||
. fromAbs $ fp) | |||
throwFileDoesNotExist :: Path Abs -> IO () | |||
throwFileDoesNotExist fp = | |||
unlessM (doesFileExist fp) (throwIO . FileDoesNotExist | |||
. fromAbs $ fp) | |||
throwDirDoesNotExist :: Path Abs -> IO () | |||
throwDirDoesNotExist fp = | |||
unlessM (doesDirectoryExist fp) (throwIO . DirDoesNotExist | |||
. fromAbs $ fp) | |||
whenM (doesDirectoryExist fp) | |||
(ioError . mkIOError | |||
alreadyExistsErrorType | |||
"Directory already exists" | |||
Nothing | |||
$ (Just (toString $ fromAbs fp)) | |||
) | |||
-- |Uses `isSameFile` and throws `SameFile` if it returns True. | |||
@@ -289,13 +269,6 @@ canOpenDirectory fp = | |||
return True | |||
throwCantOpenDirectory :: Path Abs -> IO () | |||
throwCantOpenDirectory fp = | |||
unlessM (canOpenDirectory fp) | |||
(throwIO . Can'tOpenDirectory . fromAbs $ fp) | |||
-------------------------------- | |||
@@ -375,3 +348,4 @@ reactOnError a ios fmios = | |||
else y) | |||
(throwIO ex) | |||
fmios | |||
@@ -157,8 +157,10 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure ex@[_, _]) -> | |||
any (\e -> ioeGetErrorType e == InappropriateType) ex && | |||
any (\e -> ioeGetErrorType e == PermissionDenied) ex) | |||
any (\(h, e) -> ioeGetErrorType e == InappropriateType | |||
&& isCopyFileFailed h) ex && | |||
any (\(h, e) -> ioeGetErrorType e == PermissionDenied | |||
&& isReadContentsFailed h) ex) | |||
normalDirPerms "outputDir1/foo2/foo4" | |||
normalDirPerms "outputDir1/foo2/foo4/inputFile4" | |||
c <- allDirectoryContents' "outputDir1" | |||
@@ -184,7 +186,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [e]) -> ioeGetErrorType e == PermissionDenied) | |||
(\(RecursiveFailure [(CreateDirFailed{}, e)]) -> ioeGetErrorType e == PermissionDenied) | |||
it "copyDirRecursive (Strict, CollectFailures), cannot open output dir" $ | |||
copyDirRecursive' "inputDir" | |||
@@ -200,7 +202,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [e]) -> ioeGetErrorType e == AlreadyExists) | |||
(\(RecursiveFailure [(_, e)]) -> ioeGetErrorType e == AlreadyExists) | |||
it "copyDirRecursive (Strict, CollectFailures), destination already exists and is a file" $ | |||
copyDirRecursive' "inputDir" | |||
@@ -216,7 +218,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [e]) -> ioeGetErrorType e == InappropriateType) | |||
(\(RecursiveFailure [(_, e)]) -> ioeGetErrorType e == InappropriateType) | |||
it "copyDirRecursive (Strict, CollectFailures), wrong input (symlink to directory)" $ | |||
copyDirRecursive' "wrongInputSymL" | |||
@@ -224,7 +226,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
Strict | |||
CollectFailures | |||
`shouldThrow` | |||
(\(RecursiveFailure [e]) -> ioeGetErrorType e == InvalidArgument) | |||
(\(RecursiveFailure [(_, e)]) -> ioeGetErrorType e == InvalidArgument) | |||
it "copyDirRecursive (Strict, CollectFailures), destination in source" $ | |||
copyDirRecursive' "inputDir" | |||
@@ -116,7 +116,7 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
"alreadyExistsD" | |||
Overwrite | |||
`shouldThrow` | |||
isDirDoesExist | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Overwrite), source and dest are same file" $ | |||
moveFile' "myFile" | |||
@@ -112,14 +112,14 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
"alreadyExists" | |||
Strict | |||
`shouldThrow` | |||
isFileDoesExist | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Strict), move from file to dir" $ | |||
moveFile' "myFile" | |||
"alreadyExistsD" | |||
Strict | |||
`shouldThrow` | |||
isDirDoesExist | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "moveFile (Strict), source and dest are same file" $ | |||
moveFile' "myFile" | |||
@@ -101,13 +101,13 @@ spec = beforeAll_ (upTmpDir >> setupFiles) $ afterAll_ cleanupFiles $ | |||
renameFile' "myFile" | |||
"alreadyExists" | |||
`shouldThrow` | |||
isFileDoesExist | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "renameFile, move from file to dir" $ | |||
renameFile' "myFile" | |||
"alreadyExistsD" | |||
`shouldThrow` | |||
isDirDoesExist | |||
(\e -> ioeGetErrorType e == AlreadyExists) | |||
it "renameFile, source and dest are same file" $ | |||
renameFile' "myFile" | |||