Fix build with latest hpath library
This also touches some exception handling code, be careful.
This commit is contained in:
parent
6ff620d4ae
commit
3cd7a246ab
@ -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,
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user