From ef66a24f87bcbe0a87835cf9e776187252e339a9 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Tue, 14 Jun 2016 19:13:25 +0200 Subject: [PATCH] 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') --- src/HPath/IO.hs | 78 +++++---- src/HPath/IO/Errors.hs | 150 ++++++++---------- .../IO/CopyDirRecursiveCollectFailuresSpec.hs | 14 +- test/HPath/IO/MoveFileOverwriteSpec.hs | 2 +- test/HPath/IO/MoveFileSpec.hs | 4 +- test/HPath/IO/RenameFileSpec.hs | 4 +- 6 files changed, 119 insertions(+), 133 deletions(-) diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs index 6526be3..e5ad7fc 100644 --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -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 diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs index 58cae08..1049ba1 100644 --- a/src/HPath/IO/Errors.hs +++ b/src/HPath/IO/Errors.hs @@ -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 + diff --git a/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs b/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs index 5761e62..eb30b80 100644 --- a/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs +++ b/test/HPath/IO/CopyDirRecursiveCollectFailuresSpec.hs @@ -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" diff --git a/test/HPath/IO/MoveFileOverwriteSpec.hs b/test/HPath/IO/MoveFileOverwriteSpec.hs index 80c4d22..73e241a 100644 --- a/test/HPath/IO/MoveFileOverwriteSpec.hs +++ b/test/HPath/IO/MoveFileOverwriteSpec.hs @@ -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" diff --git a/test/HPath/IO/MoveFileSpec.hs b/test/HPath/IO/MoveFileSpec.hs index 7af577b..07453af 100644 --- a/test/HPath/IO/MoveFileSpec.hs +++ b/test/HPath/IO/MoveFileSpec.hs @@ -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" diff --git a/test/HPath/IO/RenameFileSpec.hs b/test/HPath/IO/RenameFileSpec.hs index e2cfed2..85ea639 100644 --- a/test/HPath/IO/RenameFileSpec.hs +++ b/test/HPath/IO/RenameFileSpec.hs @@ -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"