Fix build with latest hpath library

This also touches some exception handling code, be careful.

hsfm.cabal

@@ -37,6 +37,7 @@ library
                        filepath >= 1.3.0.0,
                        hinotify-bytestring,
                        hpath >= 0.8.0,
+                       IfElse,
                        safe,
                        stm,
                        time >= 1.4.2,
@@ -84,6 +85,7 @@ executable hsfm-gtk
                        hinotify-bytestring,
                        hpath >= 0.8.0,
                        hsfm,
+                       IfElse,
                        monad-loops,
                        old-locale >= 1,
                        process,

src/HSFM/FileSystem/FileType.hs

@@ -300,10 +300,10 @@ instance Ord (File FileInfo) where
 
 -- |Reads a file or directory Path into an `AnchoredFile`, filling the free
 -- variables via the given function.
-readFile :: (Path Abs -> IO a)
+pathToFile :: (Path Abs -> IO a)
            -> Path Abs
            -> IO (File a)
-readFile ff p = do
+pathToFile ff p = do
     fs   <- PF.getSymbolicLinkStatus (P.toFilePath p)
     fv   <- ff p
     constructFile fs fv p
@@ -317,7 +317,7 @@ readFile ff p = do
             -- watch out, we call </> from 'filepath' here, but it is safe
             let sfp = (P.fromAbs . P.dirname $ p') </> x
             rsfp <- realpath sfp
-            f <- readFile ff =<< P.parseAbs rsfp
+            f <- pathToFile ff =<< P.parseAbs rsfp
             return $ Just f
           return $ SymLink p' fv resolvedSyml x
       | PF.isDirectory       fs = return $ Dir       p' fv
@@ -336,7 +336,7 @@ readDirectoryContents :: (Path Abs -> IO a)  -- ^ fills free a variable
                       -> IO [File a]
 readDirectoryContents ff p = do
   files <- getDirsFiles p
-  mapM (readFile ff) files
+  mapM (pathToFile ff) files
 
 
 -- |A variant of `readDirectoryContents` where the second argument
@@ -352,12 +352,12 @@ getContents _ _ = return []
 
 -- |Go up one directory in the filesystem hierarchy.
 goUp :: File FileInfo -> IO (File FileInfo)
-goUp file = readFile getFileInfo (P.dirname . path $ file)
+goUp file = pathToFile getFileInfo (P.dirname . path $ file)
 
 
 -- |Go up one directory in the filesystem hierarchy.
 goUp' :: Path Abs -> IO (File FileInfo)
-goUp' fp = readFile getFileInfo $ P.dirname fp
+goUp' fp = pathToFile getFileInfo $ P.dirname fp
 
 
 

src/HSFM/GUI/Gtk.hs

@@ -52,8 +52,8 @@ main = do
   let mdir = fromMaybe (fromJust $ P.parseAbs "/")
                        (P.parseAbs . headDef "/" $ args)
 
-  file <- catchIOError (readFile getFileInfo mdir) $
+  file <- catchIOError (pathToFile getFileInfo mdir) $
-    \_ -> readFile getFileInfo  . fromJust $ P.parseAbs "/"
+    \_ -> pathToFile getFileInfo  . fromJust $ P.parseAbs "/"
 
   _ <- initGUI
   mygui <- createMyGUI

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -39,6 +39,7 @@ import Control.Monad
   , void
   , when
   )
+import Control.Monad.IfElse
 import Control.Monad.IO.Class
   (
     liftIO
@@ -70,7 +71,6 @@ import HPath
   )
 import HPath.IO
 import HPath.IO.Errors
-import HPath.IO.Utils
 import HSFM.FileSystem.FileType
 import HSFM.FileSystem.UtilTypes
 import HSFM.GUI.Gtk.Callbacks.Utils
@@ -415,7 +415,7 @@ del items@(_:_) _ _ = withErrorDialog $ do
   withConfirmationDialog cmsg
     $ forM_ items $ \item -> easyDelete . path $ item
 del _ _ _ = withErrorDialog
-              . throwIO $ InvalidOperation
+              . ioError $ userError
                           "Operation not supported on multiple files"
 
 
@@ -430,7 +430,7 @@ moveInit items@(_:_) mygui _ = do
   popStatusbar mygui
   void $ pushStatusBar mygui sbmsg
 moveInit _ _ _ = withErrorDialog
-                   . throwIO $ InvalidOperation
+                   . ioError $ userError
                                "No file selected!"
 
 -- |Supposed to be used with 'withRows'. Initializes a file copy operation.
@@ -444,7 +444,7 @@ copyInit items@(_:_) mygui _ = do
   popStatusbar mygui
   void $ pushStatusBar mygui sbmsg
 copyInit _ _ _ = withErrorDialog
-                   . throwIO $ InvalidOperation
+                   . ioError $ userError
                                "No file selected!"
 
 
@@ -509,7 +509,7 @@ renameF [item] _ _ = withErrorDialog $ do
       HPath.IO.renameFile (path item)
                           ((P.dirname $ path item) P.</> fn)
 renameF _ _ _ = withErrorDialog
-                  . throwIO $ InvalidOperation
+                  . ioError $ userError
                               "Operation not supported on multiple files"
 
 
@@ -527,7 +527,7 @@ urlGoTo mygui myview = withErrorDialog $ do
   fp <- entryGetText (urlBar myview)
   forM_ (P.parseAbs fp :: Maybe (Path Abs)) $ \fp' ->
       whenM (canOpenDirectory fp')
-            (goDir True mygui myview =<< (readFile getFileInfo $ fp'))
+            (goDir True mygui myview =<< (pathToFile getFileInfo $ fp'))
 
 
 goHome :: MyGUI -> MyView -> IO ()
@@ -535,7 +535,7 @@ goHome mygui myview =  withErrorDialog $ do
   homedir <- home
   forM_ (P.parseAbs homedir :: Maybe (Path Abs)) $ \fp' ->
       whenM (canOpenDirectory fp')
-            (goDir True mygui myview =<< (readFile getFileInfo $ fp'))
+            (goDir True mygui myview =<< (pathToFile getFileInfo $ fp'))
 
 
 -- |Execute a given file.
@@ -543,7 +543,7 @@ execute :: [Item] -> MyGUI -> MyView -> IO ()
 execute [item] _ _ = withErrorDialog $
   void $ executeFile (path item) []
 execute _ _ _ = withErrorDialog
-                  . throwIO $ InvalidOperation
+                  . ioError $ userError
                               "Operation not supported on multiple files"
 
 
@@ -552,7 +552,7 @@ open :: [Item] -> MyGUI -> MyView -> IO ()
 open [item] mygui myview = withErrorDialog $
   case item of
     DirOrSym r -> do
-      nv <- readFile getFileInfo $ path r
+      nv <- pathToFile getFileInfo $ path r
       goDir True mygui myview nv
     r ->
       void $ openFile . path $ r
@@ -582,7 +582,7 @@ goHistoryBack mygui myview = do
   hs <- takeMVar (history myview)
   let nhs = historyBack hs
   putMVar (history myview) nhs
-  nv <- readFile getFileInfo $ currentDir nhs
+  nv <- pathToFile getFileInfo $ currentDir nhs
   goDir False mygui myview nv
   return $ currentDir nhs
 
@@ -593,7 +593,7 @@ goHistoryForward mygui myview = do
   hs <- takeMVar (history myview)
   let nhs = historyForward hs
   putMVar (history myview) nhs
-  nv <- readFile getFileInfo $ currentDir nhs
+  nv <- pathToFile getFileInfo $ currentDir nhs
   goDir False mygui myview nv
   return $ currentDir nhs
 

src/HSFM/GUI/Gtk/Callbacks/Utils.hs

@@ -83,10 +83,9 @@ _doFileOperation (f:fs) to mc rest = do
   toname <- P.basename f
   let topath = to P.</> toname
   reactOnError (mc f topath Strict >> rest)
+    -- TODO: how safe is 'AlreadyExists' here?
     [(AlreadyExists  , collisionAction fileCollisionDialog topath)]
-    [(FileDoesExist{}, collisionAction fileCollisionDialog topath)
+    [(SameFile{}     , collisionAction renameDialog topath)]
-    ,(DirDoesExist{} , collisionAction fileCollisionDialog topath)
-    ,(SameFile{}     , collisionAction renameDialog topath)]
   where
     collisionAction diag topath = do
       mcm <- diag . P.fromAbs $ topath

src/HSFM/GUI/Gtk/MyView.hs

@@ -116,7 +116,7 @@ newTab mygui nb iofmv item pos = do
   notebookSetTabReorderable (notebook myview) (viewBox myview) True
 
   catchIOError (refreshView mygui myview item) $ \e -> do
-    file <- readFile getFileInfo . fromJust . P.parseAbs . fromString
+    file <- pathToFile getFileInfo . fromJust . P.parseAbs . fromString
       $ "/"
     refreshView mygui myview file
     labelSetText label (fromString "/" :: String)