diff --git a/src/HSFM/FileSystem/Errors.hs b/src/HSFM/FileSystem/Errors.hs index 0609e00..1b3bb7d 100644 --- a/src/HSFM/FileSystem/Errors.hs +++ b/src/HSFM/FileSystem/Errors.hs @@ -29,6 +29,10 @@ import Control.Monad when , forM ) +import Data.ByteString + ( + ByteString + ) import Data.Typeable import Foreign.C.Error ( @@ -51,23 +55,50 @@ import qualified System.Posix.Files.ByteString as PF import qualified System.Posix.Directory.ByteString as PFD -data FmIOException = FileDoesNotExist String - | DirDoesNotExist String - | PathNotAbsolute String - | FileNotExecutable String - | SameFile String String - | NotAFile String - | NotADir String - | DestinationInSource String String - | FileDoesExist String - | DirDoesExist String - | IsSymlink String +data FmIOException = 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 String + | Can'tOpenDirectory ByteString | CopyFailed String | MoveFailed String - deriving (Show, Typeable) + deriving (Typeable) + + +instance Show FmIOException where + show (FileDoesNotExist fp) = "File does not exist:" ++ P.fpToString fp + show (DirDoesNotExist fp) = "Directory does not exist: " + ++ P.fpToString fp + show (PathNotAbsolute fp) = "Path not absolute: " ++ P.fpToString fp + show (FileNotExecutable fp) = "File not executable: " + ++ P.fpToString fp + show (SameFile fp1 fp2) = P.fpToString fp1 + ++ " and " ++ P.fpToString fp2 + ++ " are the same file!" + show (NotAFile fp) = "Not a file: " ++ P.fpToString fp + show (NotADir fp) = "Not a directory: " ++ P.fpToString fp + show (DestinationInSource fp1 fp2) = P.fpToString fp1 + ++ " is contained in " + ++ P.fpToString fp2 + show (FileDoesExist fp) = "File does exist: " ++ P.fpToString fp + show (DirDoesExist fp) = "Directory does exist: " ++ P.fpToString fp + show (IsSymlink fp) = "Is a symlink: " ++ P.fpToString fp + show (InvalidOperation str) = "Invalid operation: " ++ str + show InvalidFileName = "Invalid file name!" + show (Can'tOpenDirectory fp) = "Can't open directory: " + ++ P.fpToString fp + show (CopyFailed str) = "Copying failed: " ++ show str + show (MoveFailed str) = "Movinf failed: " ++ show str + instance Exception FmIOException @@ -83,25 +114,25 @@ instance Exception FmIOException throwFileDoesExist :: Path Abs -> IO () throwFileDoesExist fp = whenM (doesFileExist fp) (throw . FileDoesExist - . P.fpToString . P.fromAbs $ fp) + . P.fromAbs $ fp) throwDirDoesExist :: Path Abs -> IO () throwDirDoesExist fp = whenM (doesDirectoryExist fp) (throw . DirDoesExist - . P.fpToString . P.fromAbs $ fp) + . P.fromAbs $ fp) throwFileDoesNotExist :: Path Abs -> IO () throwFileDoesNotExist fp = whenM (doesFileExist fp) (throw . FileDoesExist - . P.fpToString . P.fromAbs $ fp) + . P.fromAbs $ fp) throwDirDoesNotExist :: Path Abs -> IO () throwDirDoesNotExist fp = whenM (doesDirectoryExist fp) (throw . DirDoesExist - . P.fpToString . P.fromAbs $ fp) + . P.fromAbs $ fp) throwSameFile :: Path Abs -- ^ will be canonicalized @@ -115,8 +146,7 @@ throwSameFile fp1 fp2 = do (\_ -> fmap P.fromAbs $ (P. P.basename fp2) <$> (P.canonicalizePath $ P.dirname fp2)) - when (P.equalFilePath fp1' fp2') (throw $ SameFile (P.fpToString fp1') - (P.fpToString fp2')) + when (P.equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2') -- |Checks whether the destination directory is contained @@ -136,8 +166,8 @@ throwDestinationInSource source dest = do sid <- fmap (\x -> (PF.deviceID x, PF.fileID x)) $ PF.getSymbolicLinkStatus (P.fromAbs source') when (elem sid dids) - (throw $ DestinationInSource (P.fpToString $ P.fromAbs dest) - (P.fpToString $ P.fromAbs source)) + (throw $ DestinationInSource (P.fromAbs dest) + (P.fromAbs source)) -- |Checks if the given file exists and is not a directory. This follows @@ -176,7 +206,7 @@ canOpenDirectory fp = throwCantOpenDirectory :: Path Abs -> IO () throwCantOpenDirectory fp = unlessM (canOpenDirectory fp) - (throw . Can'tOpenDirectory . show . P.fromAbs $ fp) + (throw . Can'tOpenDirectory . P.fromAbs $ fp) diff --git a/src/HSFM/FileSystem/FileOperations.hs b/src/HSFM/FileSystem/FileOperations.hs index 8352e66..3236d8d 100644 --- a/src/HSFM/FileSystem/FileOperations.hs +++ b/src/HSFM/FileSystem/FileOperations.hs @@ -468,7 +468,7 @@ deleteDirRecursive f'@(_ :/ Dir {}) = do (_ :/ Dir {}) -> go file (_ :/ RegFile {}) -> removeLink (P.toFilePath . fullPath $ file) _ -> throw $ FileDoesExist - (P.fpToString . P.toFilePath . fullPath + (P.toFilePath . fullPath $ file) removeDirectory . P.toFilePath $ fp go _ = throw $ InvalidOperation "wrong input type" diff --git a/src/HSFM/FileSystem/FileType.hs b/src/HSFM/FileSystem/FileType.hs index b5a8191..21def3f 100644 --- a/src/HSFM/FileSystem/FileType.hs +++ b/src/HSFM/FileSystem/FileType.hs @@ -601,7 +601,7 @@ getDirsFiles' :: (Path Fn -> [Path Fn] -> [Path Fn]) -- ^ filter function -> Path Abs -- ^ dir to read -> IO [Path Fn] getDirsFiles' filterf fp = - rethrowErrnoAs [eACCES] (Can'tOpenDirectory . P.fpToString . P.fromAbs $ fp) + rethrowErrnoAs [eACCES] (Can'tOpenDirectory . P.fromAbs $ fp) $ bracket (PFD.openDirStream . P.toFilePath $ fp) PFD.closeDirStream $ \dirstream -> @@ -662,7 +662,7 @@ getFileInfo fp = do -- Handles an IO exception by returning a Failed constructor filled with that --- exception. +-- exception. Does not handle FmIOExceptions. handleDT :: Path Abs -> Path Fn -> IO (AnchoredFile a) diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index 405325f..5ab8f6e 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/src/HSFM/GUI/Gtk/Callbacks.hs @@ -16,6 +16,7 @@ along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. --} +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK ignore-exports #-} module HSFM.GUI.Gtk.Callbacks where diff --git a/src/HSFM/GUI/Gtk/Dialogs.hs b/src/HSFM/GUI/Gtk/Dialogs.hs index 9e3bca6..b9ec29d 100644 --- a/src/HSFM/GUI/Gtk/Dialogs.hs +++ b/src/HSFM/GUI/Gtk/Dialogs.hs @@ -24,14 +24,17 @@ module HSFM.GUI.Gtk.Dialogs where import Control.Exception ( catch + , displayException , throw - , try - , SomeException + , IOException + , catches + , Handler(..) ) import Control.Monad ( forM , when + , void ) import Data.Version ( @@ -209,11 +212,13 @@ withConfirmationDialog str io = do -- |Execute the given IO action. If the action throws exceptions, -- visualize them via 'showErrorDialog'. withErrorDialog :: IO a -> IO () -withErrorDialog io = do - r <- try io - either (\e -> showErrorDialog $ show (e :: SomeException)) - (\_ -> return ()) - r +withErrorDialog io = + catches (void io) + [ Handler (\e -> showErrorDialog + $ displayException (e :: IOException)) + , Handler (\e -> showErrorDialog + $ displayException (e :: FmIOException)) + ] -- |Asks the user which directory copy mode he wants via dialog popup