diff --git a/hsfm.cabal b/hsfm.cabal index ee5e37e..ace31bd 100644 --- a/hsfm.cabal +++ b/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, diff --git a/src/HSFM/FileSystem/FileType.hs b/src/HSFM/FileSystem/FileType.hs index a3e9034..9a87fc3 100644 --- a/src/HSFM/FileSystem/FileType.hs +++ b/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) - -> Path Abs - -> IO (File a) -readFile ff p = do +pathToFile :: (Path Abs -> IO a) + -> Path Abs + -> IO (File a) +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 diff --git a/src/HSFM/GUI/Gtk.hs b/src/HSFM/GUI/Gtk.hs index 419f019..fe985d0 100644 --- a/src/HSFM/GUI/Gtk.hs +++ b/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) $ - \_ -> readFile getFileInfo . fromJust $ P.parseAbs "/" + file <- catchIOError (pathToFile getFileInfo mdir) $ + \_ -> pathToFile getFileInfo . fromJust $ P.parseAbs "/" _ <- initGUI mygui <- createMyGUI diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index fd99f55..6673618 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/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 diff --git a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs b/src/HSFM/GUI/Gtk/Callbacks/Utils.hs index 0fa7fcb..bd27fc7 100644 --- a/src/HSFM/GUI/Gtk/Callbacks/Utils.hs +++ b/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) - ,(DirDoesExist{} , collisionAction fileCollisionDialog topath) - ,(SameFile{} , collisionAction renameDialog topath)] + [(SameFile{} , collisionAction renameDialog topath)] where collisionAction diag topath = do mcm <- diag . P.fromAbs $ topath diff --git a/src/HSFM/GUI/Gtk/MyView.hs b/src/HSFM/GUI/Gtk/MyView.hs index d9e029f..34774f5 100644 --- a/src/HSFM/GUI/Gtk/MyView.hs +++ b/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)