LIB/GTK: use fullPathS
This commit is contained in:
parent
74a48b2668
commit
5e232e3d4a
@ -226,7 +226,7 @@ recreateSymlink _ _ AFileInvFN = throw InvalidFileName
|
|||||||
recreateSymlink cm symf@(_ :/ SymLink {})
|
recreateSymlink cm symf@(_ :/ SymLink {})
|
||||||
symdest@(_ :/ Dir {})
|
symdest@(_ :/ Dir {})
|
||||||
= do
|
= do
|
||||||
sympoint <- readSymbolicLink (P.fromAbs . fullPath $ symf)
|
sympoint <- readSymbolicLink (fullPathS $ symf)
|
||||||
let symname = fullPath symdest P.</> (name . file $ symf)
|
let symname = fullPath symdest P.</> (name . file $ symf)
|
||||||
case cm of
|
case cm of
|
||||||
Merge -> delOld symname
|
Merge -> delOld symname
|
||||||
@ -264,8 +264,8 @@ overwriteFile _ AFileInvFN = throw InvalidFileName
|
|||||||
overwriteFile from@(_ :/ RegFile {})
|
overwriteFile from@(_ :/ RegFile {})
|
||||||
to@(_ :/ RegFile {})
|
to@(_ :/ RegFile {})
|
||||||
= do
|
= do
|
||||||
let from' = P.fromAbs . fullPath $ from
|
let from' = fullPathS from
|
||||||
to' = P.fromAbs . fullPath $ to
|
to' = fullPathS to
|
||||||
throwSameFile from' to'
|
throwSameFile from' to'
|
||||||
copyFile' from' to'
|
copyFile' from' to'
|
||||||
overwriteFile _ _ = throw $ InvalidOperation "wrong input type"
|
overwriteFile _ _ = throw $ InvalidOperation "wrong input type"
|
||||||
@ -282,7 +282,7 @@ copyFileToDir _ _ AFileInvFN = throw InvalidFileName
|
|||||||
copyFileToDir cm from@(_ :/ RegFile fn _)
|
copyFileToDir cm from@(_ :/ RegFile fn _)
|
||||||
to@(_ :/ Dir {})
|
to@(_ :/ Dir {})
|
||||||
= do
|
= do
|
||||||
let from' = P.fromAbs . fullPath $ from
|
let from' = fullPathS from
|
||||||
to' = P.fromAbs (fullPath to P.</> fn)
|
to' = P.fromAbs (fullPath to P.</> fn)
|
||||||
case cm of
|
case cm of
|
||||||
Strict -> throwFileDoesExist to'
|
Strict -> throwFileDoesExist to'
|
||||||
@ -382,7 +382,7 @@ easyDelete _ = throw $ InvalidOperation "wrong input type"
|
|||||||
openFile :: AnchoredFile a
|
openFile :: AnchoredFile a
|
||||||
-> IO ProcessHandle
|
-> IO ProcessHandle
|
||||||
openFile AFileInvFN = throw InvalidFileName
|
openFile AFileInvFN = throw InvalidFileName
|
||||||
openFile f = spawnProcess "xdg-open" [P.fromAbs . fullPath $ f]
|
openFile f = spawnProcess "xdg-open" [fullPathS f]
|
||||||
|
|
||||||
|
|
||||||
-- |Executes a program with the given arguments.
|
-- |Executes a program with the given arguments.
|
||||||
@ -391,7 +391,7 @@ executeFile :: AnchoredFile FileInfo -- ^ program
|
|||||||
-> IO ProcessHandle
|
-> IO ProcessHandle
|
||||||
executeFile AFileInvFN _ = throw InvalidFileName
|
executeFile AFileInvFN _ = throw InvalidFileName
|
||||||
executeFile prog@(_ :/ RegFile {}) args
|
executeFile prog@(_ :/ RegFile {}) args
|
||||||
= spawnProcess (P.fromAbs . fullPath $ prog) args
|
= spawnProcess (fullPathS prog) args
|
||||||
executeFile _ _ = throw $ InvalidOperation "wrong input type"
|
executeFile _ _ = throw $ InvalidOperation "wrong input type"
|
||||||
|
|
||||||
|
|
||||||
@ -434,7 +434,7 @@ renameFile :: AnchoredFile FileInfo -> Path Fn -> IO ()
|
|||||||
renameFile AFileInvFN _ = throw InvalidFileName
|
renameFile AFileInvFN _ = throw InvalidFileName
|
||||||
renameFile _ InvFN = throw InvalidFileName
|
renameFile _ InvFN = throw InvalidFileName
|
||||||
renameFile af (ValFN fn) = do
|
renameFile af (ValFN fn) = do
|
||||||
let fromf = P.fromAbs . fullPath $ af
|
let fromf = fullPathS af
|
||||||
tof = P.fromAbs (anchor af P.</> fn)
|
tof = P.fromAbs (anchor af P.</> fn)
|
||||||
throwFileDoesExist tof
|
throwFileDoesExist tof
|
||||||
throwSameFile fromf tof
|
throwSameFile fromf tof
|
||||||
@ -451,7 +451,7 @@ moveFile _ AFileInvFN _ = throw InvalidFileName
|
|||||||
moveFile _ _ AFileInvFN = throw InvalidFileName
|
moveFile _ _ AFileInvFN = throw InvalidFileName
|
||||||
moveFile cm from to@(_ :/ Dir {}) = do
|
moveFile cm from to@(_ :/ Dir {}) = do
|
||||||
let from' = fullPath from
|
let from' = fullPath from
|
||||||
froms' = P.fromAbs . fullPath $ from
|
froms' = fullPathS from
|
||||||
to' = fullPath to P.</> (name . file $ from)
|
to' = fullPath to P.</> (name . file $ from)
|
||||||
tos' = P.fromAbs (fullPath to P.</> (name . file $ from))
|
tos' = P.fromAbs (fullPath to P.</> (name . file $ from))
|
||||||
case cm of
|
case cm of
|
||||||
|
@ -241,7 +241,7 @@ execute _ _ _ = withErrorDialog
|
|||||||
-- |Supposed to be used with 'withRows'. Deletes a file or directory.
|
-- |Supposed to be used with 'withRows'. Deletes a file or directory.
|
||||||
del :: [Item] -> MyGUI -> MyView -> IO ()
|
del :: [Item] -> MyGUI -> MyView -> IO ()
|
||||||
del [item] mygui myview = withErrorDialog $ do
|
del [item] mygui myview = withErrorDialog $ do
|
||||||
let cmsg = "Really delete \"" ++ P.fromAbs (fullPath item) ++ "\"?"
|
let cmsg = "Really delete \"" ++ fullPathS item ++ "\"?"
|
||||||
withConfirmationDialog cmsg
|
withConfirmationDialog cmsg
|
||||||
$ easyDelete item
|
$ easyDelete item
|
||||||
-- this throws on the first error that occurs
|
-- this throws on the first error that occurs
|
||||||
@ -258,7 +258,7 @@ del _ _ _ = withErrorDialog
|
|||||||
moveInit :: [Item] -> MyGUI -> MyView -> IO ()
|
moveInit :: [Item] -> MyGUI -> MyView -> IO ()
|
||||||
moveInit [item] mygui myview = do
|
moveInit [item] mygui myview = do
|
||||||
writeTVarIO (operationBuffer myview) (FMove . MP1 $ item)
|
writeTVarIO (operationBuffer myview) (FMove . MP1 $ item)
|
||||||
let sbmsg = "Move buffer: " ++ P.fromAbs (fullPath item)
|
let sbmsg = "Move buffer: " ++ fullPathS item
|
||||||
popStatusbar mygui
|
popStatusbar mygui
|
||||||
void $ pushStatusBar mygui sbmsg
|
void $ pushStatusBar mygui sbmsg
|
||||||
moveInit _ _ _ = withErrorDialog
|
moveInit _ _ _ = withErrorDialog
|
||||||
@ -269,7 +269,7 @@ moveInit _ _ _ = withErrorDialog
|
|||||||
copyInit :: [Item] -> MyGUI -> MyView -> IO ()
|
copyInit :: [Item] -> MyGUI -> MyView -> IO ()
|
||||||
copyInit [item] mygui myview = do
|
copyInit [item] mygui myview = do
|
||||||
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ item)
|
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ item)
|
||||||
let sbmsg = "Copy buffer: " ++ P.fromAbs (fullPath item)
|
let sbmsg = "Copy buffer: " ++ fullPathS item
|
||||||
popStatusbar mygui
|
popStatusbar mygui
|
||||||
void $ pushStatusBar mygui sbmsg
|
void $ pushStatusBar mygui sbmsg
|
||||||
copyInit _ _ _ = withErrorDialog
|
copyInit _ _ _ = withErrorDialog
|
||||||
@ -284,14 +284,14 @@ operationFinal mygui myview = withErrorDialog $ do
|
|||||||
cdir <- getCurrentDir myview
|
cdir <- getCurrentDir myview
|
||||||
case op of
|
case op of
|
||||||
FMove (MP1 s) -> do
|
FMove (MP1 s) -> do
|
||||||
let cmsg = "Really move \"" ++ P.fromAbs (fullPath s)
|
let cmsg = "Really move \"" ++ fullPathS s
|
||||||
++ "\"" ++ " to \"" ++ P.fromAbs (fullPath cdir) ++ "\"?"
|
++ "\"" ++ " to \"" ++ fullPathS cdir ++ "\"?"
|
||||||
withConfirmationDialog cmsg . withCopyModeDialog
|
withConfirmationDialog cmsg . withCopyModeDialog
|
||||||
$ \cm -> void $ runFileOp (FMove . MC s cdir $ cm)
|
$ \cm -> void $ runFileOp (FMove . MC s cdir $ cm)
|
||||||
return ()
|
return ()
|
||||||
FCopy (CP1 s) -> do
|
FCopy (CP1 s) -> do
|
||||||
let cmsg = "Really copy \"" ++ P.fromAbs (fullPath s)
|
let cmsg = "Really copy \"" ++ fullPathS s
|
||||||
++ "\"" ++ " to \"" ++ P.fromAbs (fullPath cdir) ++ "\"?"
|
++ "\"" ++ " to \"" ++ fullPathS cdir ++ "\"?"
|
||||||
withConfirmationDialog cmsg . withCopyModeDialog
|
withConfirmationDialog cmsg . withCopyModeDialog
|
||||||
$ \cm -> void $ runFileOp (FCopy . CC s cdir $ cm)
|
$ \cm -> void $ runFileOp (FCopy . CC s cdir $ cm)
|
||||||
return ()
|
return ()
|
||||||
@ -323,7 +323,7 @@ renameF [item] mygui myview = withErrorDialog $ do
|
|||||||
mfn <- textInputDialog "Enter new file name"
|
mfn <- textInputDialog "Enter new file name"
|
||||||
let pmfn = P.parseFn =<< mfn
|
let pmfn = P.parseFn =<< mfn
|
||||||
for_ pmfn $ \fn -> do
|
for_ pmfn $ \fn -> do
|
||||||
let cmsg = "Really rename \"" ++ P.fromAbs (fullPath item)
|
let cmsg = "Really rename \"" ++ fullPathS item
|
||||||
++ "\"" ++ " to \"" ++ P.fromAbs (anchor item P.</> fn) ++ "\"?"
|
++ "\"" ++ " to \"" ++ P.fromAbs (anchor item P.</> fn) ++ "\"?"
|
||||||
withConfirmationDialog cmsg $
|
withConfirmationDialog cmsg $
|
||||||
HSFM.FileSystem.FileOperations.renameFile item fn
|
HSFM.FileSystem.FileOperations.renameFile item fn
|
||||||
|
Loading…
Reference in New Issue
Block a user