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

Improve error handling

Browse Source 
* 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:
Julian Ospald 2016-06-14 19:13:25 +02:00
parent f6a5cb8668
commit ef66a24f87
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
6 changed files with 119 additions and 133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
src/HPath/IO.hs
View File

@ -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,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
-- 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
-- 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
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 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

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

@ -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

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

@ -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"

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

@ -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"

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

@ -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"

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

@ -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"