Improve error handling
* 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')
This commit is contained in:
parent
f6a5cb8668
commit
ef66a24f87
@ -226,7 +226,7 @@ data FileType = Directory
|
||||
|
||||
|
||||
|
||||
-- |The error mode for any recursive operation.
|
||||
-- |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,14 +322,20 @@ 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'
|
||||
|
||||
-- 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'
|
||||
@ -342,21 +348,30 @@ copyDirRecursive fromp destdirp cm rm
|
||||
_ -> ioError e
|
||||
return contents
|
||||
|
||||
-- we can't use `easyCopy` here, because we want to call `go`
|
||||
-- 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
|
||||
|
||||
-- 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 (e:)
|
||||
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 file already exists
|
||||
-- - `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 file already exists
|
||||
-- - `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 directory already exists
|
||||
-- - `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
|
||||
-- - `FileDoesExist` if destination file already exists
|
||||
-- (`HPathIOException`)
|
||||
-- - `DirDoesExist` if destination directory already exists
|
||||
-- (`HPathIOException`)
|
||||
-- - `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:
|
||||
--
|
||||
-- - `FileDoesExist` if destination file already exists (`HPathIOException`)
|
||||
-- - `DirDoesExist` if destination directory already exists
|
||||
-- (`HPathIOException`)
|
||||
-- - `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,57 +100,36 @@ 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
|
||||
|
||||
|
||||
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"
|
||||
| RecursiveFailure [(RecursiveFailureHint, IOException)]
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
-- |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
|
||||
|
||||
|
||||
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
|
||||
|
||||
|
||||
-- |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)
|
||||
|
||||
|
||||
|
||||
--------------------------------
|
||||
@ -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"
|
||||
|
Loading…
Reference in New Issue
Block a user