diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,9 @@ +0.6.0: + * fixes 'throwDestinationInSource' to be more reliable. + * removes some unused HPathIOException constructors + * consistently provide exception constructor identifiers + * be less harsh when non-supported file types get passed to our functions, possibly ignoring them + * minor cleanups 0.5.9: * Adds our posix-paths fork and a lot of IO operations. 0.5.8: diff --git a/hpath.cabal b/hpath.cabal --- a/hpath.cabal +++ b/hpath.cabal @@ -1,5 +1,5 @@ name: hpath -version: 0.5.9 +version: 0.6.0 synopsis: Support for well-typed paths description: Support for well-typed paths, utilizing ByteString under the hood. license: GPL-2 diff --git a/src/HPath/IO.hs b/src/HPath/IO.hs --- a/src/HPath/IO.hs +++ b/src/HPath/IO.hs @@ -27,7 +27,8 @@ -- -- Note: `BlockDevice`, `CharacterDevice`, `NamedPipe` and `Socket` -- are not explicitly supported right now. Calling any of these --- functions on such a file may throw an exception. +-- functions on such a file may throw an exception or just do +-- nothing. {-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-} @@ -185,6 +186,11 @@ + ------------- + --[ Types ]-- + ------------- + + data FileType = Directory | RegularFile | SymbolicLink @@ -252,8 +258,7 @@ SymbolicLink -> recreateSymlink f newdest Directory -> go f newdest RegularFile -> copyFile f newdest - _ -> ioError $ userError $ "No idea what to do with the" ++ - "given filetype: " ++ show ftype + _ -> return () -- |Like `copyDirRecursive` except it overwrites contents of directories @@ -298,9 +303,7 @@ >> recreateSymlink f newdest Directory -> go f newdest RegularFile -> copyFileOverwrite f newdest - _ -> ioError $ userError $ "No idea what to do with the" ++ - "given filetype: " ++ show ftype - + _ -> return () -- |Recreate a symlink. -- @@ -395,13 +398,13 @@ -> IO () _copyFile sflags dflags from to = - -- TODO: add sendfile support - withAbsPath to $ \to' -> withAbsPath from $ \from' -> - void $ fallbackCopy from' to' + -- TODO: add sendfile support + void $ readWriteCopy (fromAbs from) (fromAbs to) where -- low-level copy operation utilizing read(2)/write(2) -- in case `sendFileCopy` fails/is unsupported - fallbackCopy source dest = + readWriteCopy :: ByteString -> ByteString -> IO Int + readWriteCopy source dest = bracket (SPDT.openFd source SPI.ReadOnly sflags Nothing) SPI.closeFd $ \sfd -> do @@ -442,8 +445,7 @@ SymbolicLink -> recreateSymlink from to RegularFile -> copyFile from to Directory -> copyDirRecursive from to - _ -> ioError $ userError $ "No idea what to do with the" ++ - "given filetype: " ++ show ftype + _ -> return () -- |Like `easyCopy` except it overwrites the destination if it already exists. @@ -459,8 +461,7 @@ >> recreateSymlink from to RegularFile -> copyFileOverwrite from to Directory -> copyDirRecursiveOverwrite from to - _ -> ioError $ userError $ "No idea what to do with the" ++ - "given filetype: " ++ show ftype + _ -> return () @@ -526,8 +527,7 @@ SymbolicLink -> deleteFile file Directory -> deleteDirRecursive file RegularFile -> deleteFile file - _ -> ioError $ userError $ "No idea what to do with the" ++ - "given filetype: " ++ show ftype + _ -> return () removeDirectory . toFilePath $ p @@ -546,8 +546,7 @@ SymbolicLink -> deleteFile p Directory -> deleteDirRecursive p RegularFile -> deleteFile p - _ -> ioError $ userError $ "No idea what to do with the" ++ - "given filetype: " ++ show ftype + _ -> return () @@ -705,8 +704,7 @@ Directory -> do exists <- doesDirectoryExist to when (exists && writable) (deleteDir to) - _ -> ioError $ userError $ "Don't know how to handle filetype " ++ - show ft + _ -> return () moveFile from to diff --git a/src/HPath/IO.hs-boot b/src/HPath/IO.hs-boot new file mode 100644 --- /dev/null +++ b/src/HPath/IO.hs-boot @@ -0,0 +1,7 @@ +module HPath.IO where + + +import HPath + +canonicalizePath :: Path Abs -> IO (Path Abs) + diff --git a/src/HPath/IO/Errors.hs b/src/HPath/IO/Errors.hs --- a/src/HPath/IO/Errors.hs +++ b/src/HPath/IO/Errors.hs @@ -12,9 +12,46 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} -module HPath.IO.Errors where +module HPath.IO.Errors + ( + -- * Types + HPathIOException(..) + -- * Exception identifiers + , isFileDoesNotExist + , isDirDoesNotExist + , isSameFile + , isDestinationInSource + , isFileDoesExist + , isDirDoesExist + , isInvalidOperation + , isCan'tOpenDirectory + , isCopyFailed + -- * Path based functions + , throwFileDoesExist + , throwDirDoesExist + , throwFileDoesNotExist + , throwDirDoesNotExist + , throwSameFile + , sameFile + , throwDestinationInSource + , doesFileExist + , doesDirectoryExist + , isWritable + , canOpenDirectory + , throwCantOpenDirectory + + -- * Error handling functions + , catchErrno + , rethrowErrnoAs + , handleIOError + , bracketeer + , reactOnError + ) + where + + import Control.Applicative ( (<$>) @@ -44,6 +81,10 @@ IOErrorType ) import HPath +import {-# SOURCE #-} HPath.IO + ( + canonicalizePath + ) import HPath.IO.Utils import System.IO.Error ( @@ -62,20 +103,13 @@ data HPathIOException = FileDoesNotExist ByteString | DirDoesNotExist ByteString - | PathNotAbsolute ByteString - | FileNotExecutable ByteString | SameFile ByteString ByteString - | NotAFile ByteString - | NotADir ByteString | DestinationInSource ByteString ByteString | FileDoesExist ByteString | DirDoesExist ByteString - | IsSymlink ByteString | InvalidOperation String - | InvalidFileName | Can'tOpenDirectory ByteString | CopyFailed String - | MoveFailed String deriving (Typeable, Eq, Data) @@ -83,26 +117,18 @@ show (FileDoesNotExist fp) = "File does not exist:" ++ fpToString fp show (DirDoesNotExist fp) = "Directory does not exist: " ++ fpToString fp - show (PathNotAbsolute fp) = "Path not absolute: " ++ fpToString fp - show (FileNotExecutable fp) = "File not executable: " - ++ fpToString fp show (SameFile fp1 fp2) = fpToString fp1 ++ " and " ++ fpToString fp2 ++ " are the same file!" - show (NotAFile fp) = "Not a file: " ++ fpToString fp - show (NotADir fp) = "Not a directory: " ++ fpToString fp show (DestinationInSource fp1 fp2) = fpToString fp1 ++ " is contained in " ++ fpToString fp2 show (FileDoesExist fp) = "File does exist: " ++ fpToString fp show (DirDoesExist fp) = "Directory does exist: " ++ fpToString fp - show (IsSymlink fp) = "Is a symlink: " ++ fpToString fp show (InvalidOperation str) = "Invalid operation: " ++ str - show InvalidFileName = "Invalid file name!" show (Can'tOpenDirectory fp) = "Can't open directory: " ++ fpToString fp show (CopyFailed str) = "Copying failed: " ++ str - show (MoveFailed str) = "Moving failed: " ++ str @@ -110,27 +136,26 @@ -isDestinationInSource :: HPathIOException -> Bool -isDestinationInSource (DestinationInSource _ _) = True -isDestinationInSource _ = False -isSameFile :: HPathIOException -> Bool -isSameFile (SameFile _ _) = True -isSameFile _ = False + ----------------------------- + --[ Exception identifiers ]-- + ----------------------------- +isFileDoesNotExist, isDirDoesNotExist, isSameFile, isDestinationInSource, isFileDoesExist, isDirDoesExist, isInvalidOperation, isCan'tOpenDirectory, isCopyFailed :: HPathIOException -> Bool +isFileDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr FileDoesNotExist{} +isDirDoesNotExist ex = toConstr (ex :: HPathIOException) == toConstr DirDoesNotExist{} +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{} -isFileDoesExist :: HPathIOException -> Bool -isFileDoesExist (FileDoesExist _) = True -isFileDoesExist _ = False -isDirDoesExist :: HPathIOException -> Bool -isDirDoesExist (DirDoesExist _) = True -isDirDoesExist _ = False - - ---------------------------- --[ Path based functions ]-- ---------------------------- @@ -194,8 +219,7 @@ -> IO () throwDestinationInSource source dest = do dest' <- (\x -> maybe x (\y -> x y) $ basename dest) - {- <$> (canonicalizePath $ P.dirname dest) -} - <$> (return $ dirname dest) + <$> (canonicalizePath $ dirname dest) dids <- forM (getAllParents dest') $ \p -> do fs <- PF.getSymbolicLinkStatus (fromAbs p) return (PF.deviceID fs, PF.fileID fs)