LIB/GTK: improve exceptions/error handling

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
+data FmIOException = FileDoesNotExist ByteString
-                   | DirDoesNotExist String
+                   | DirDoesNotExist ByteString
-                   | PathNotAbsolute String
+                   | PathNotAbsolute ByteString
-                   | FileNotExecutable String
+                   | FileNotExecutable ByteString
-                   | SameFile String String
+                   | SameFile ByteString ByteString
-                   | NotAFile String
+                   | NotAFile ByteString
-                   | NotADir String
+                   | NotADir ByteString
-                   | DestinationInSource String String
+                   | DestinationInSource ByteString ByteString
-                   | FileDoesExist String
+                   | FileDoesExist ByteString
-                   | DirDoesExist String
+                   | DirDoesExist ByteString
-                   | IsSymlink String
+                   | 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')
+  when (P.equalFilePath fp1' fp2') (throw $ SameFile fp1' fp2')
-                                                     (P.fpToString 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)
+       (throw $ DestinationInSource (P.fromAbs dest)
-                                    (P.fpToString $ P.fromAbs source))
+                                    (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)
 
 
 

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"

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)

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

src/HSFM/GUI/Gtk/Dialogs.hs

@@ -24,14 +24,17 @@ module HSFM.GUI.Gtk.Dialogs where
 import Control.Exception
   (
     catch
+  , displayException
   , throw
-  , try
+  , IOException
-  , SomeException
+  , 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
+withErrorDialog io =
-  r <- try io
+  catches (void io)
-  either (\e -> showErrorDialog $ show (e :: SomeException))
+    [ Handler (\e -> showErrorDialog
-         (\_ -> return ())
+                       $ displayException (e :: IOException))
-         r
+    , Handler (\e -> showErrorDialog
+                       $ displayException (e :: FmIOException))
+    ]
 
 
 -- |Asks the user which directory copy mode he wants via dialog popup