LIB/GTK: implement copy/move/delete for multiple files
This commit is contained in:
parent
418365db0f
commit
478ffa0e98
@ -109,7 +109,7 @@ import System.Posix.Types
|
||||
-- or delay operations.
|
||||
data FileOperation = FCopy Copy
|
||||
| FMove Move
|
||||
| FDelete (AnchoredFile FileInfo)
|
||||
| FDelete [AnchoredFile FileInfo]
|
||||
| FOpen (AnchoredFile FileInfo)
|
||||
| FExecute (AnchoredFile FileInfo) [ByteString]
|
||||
| None
|
||||
@ -117,18 +117,18 @@ data FileOperation = FCopy Copy
|
||||
|
||||
-- |Data type describing partial or complete file copy operation.
|
||||
-- CC stands for a complete operation and can be used for `runFileOp`.
|
||||
data Copy = CP1 (AnchoredFile FileInfo)
|
||||
| CP2 (AnchoredFile FileInfo)
|
||||
data Copy = CP1 [AnchoredFile FileInfo]
|
||||
| CP2 [AnchoredFile FileInfo]
|
||||
(AnchoredFile FileInfo)
|
||||
| CC (AnchoredFile FileInfo)
|
||||
| CC [AnchoredFile FileInfo]
|
||||
(AnchoredFile FileInfo)
|
||||
CopyMode
|
||||
|
||||
|
||||
-- |Data type describing partial or complete file move operation.
|
||||
-- MC stands for a complete operation and can be used for `runFileOp`.
|
||||
data Move = MP1 (AnchoredFile FileInfo)
|
||||
| MC (AnchoredFile FileInfo)
|
||||
data Move = MP1 [AnchoredFile FileInfo]
|
||||
| MC [AnchoredFile FileInfo]
|
||||
(AnchoredFile FileInfo)
|
||||
CopyMode
|
||||
|
||||
@ -144,11 +144,13 @@ data CopyMode = Strict -- ^ fail if the target already exists
|
||||
-- |Run a given FileOperation. If the FileOperation is partial, it will
|
||||
-- be returned.
|
||||
runFileOp :: FileOperation -> IO (Maybe FileOperation)
|
||||
runFileOp (FCopy (CC from to cm)) = easyCopy cm from to >> return Nothing
|
||||
runFileOp (FCopy (CC froms to cm)) = mapM_ (\x -> easyCopy cm x to) froms
|
||||
>> return Nothing
|
||||
runFileOp (FCopy fo) = return $ Just $ FCopy fo
|
||||
runFileOp (FMove (MC from to cm)) = moveFile cm from to >> return Nothing
|
||||
runFileOp (FMove (MC froms to cm)) = mapM_ (\x -> moveFile cm x to) froms
|
||||
>> return Nothing
|
||||
runFileOp (FMove fo) = return $ Just $ FMove fo
|
||||
runFileOp (FDelete fp) = easyDelete fp >> return Nothing
|
||||
runFileOp (FDelete fp) = mapM_ easyDelete fp >> return Nothing
|
||||
runFileOp (FOpen fp) = openFile fp >> return Nothing
|
||||
runFileOp (FExecute fp args) = executeFile fp args >> return Nothing
|
||||
runFileOp _ = return Nothing
|
||||
@ -268,7 +270,6 @@ copyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
|
||||
$ System.Posix.Files.ByteString.fileMode fromFstatus)
|
||||
SPI.closeFd
|
||||
(\fd -> void $ fdWrite fd fromContent)
|
||||
|
||||
copyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
|
||||
|
||||
|
||||
|
@ -251,25 +251,31 @@ del _ _ _ = withErrorDialog
|
||||
|
||||
-- |Initializes a file move operation.
|
||||
moveInit :: [Item] -> MyGUI -> MyView -> IO ()
|
||||
moveInit [item] mygui myview = do
|
||||
writeTVarIO (operationBuffer myview) (FMove . MP1 $ item)
|
||||
let sbmsg = "Move buffer: " ++ P.fpToString (fullPathS item)
|
||||
moveInit items@(_:_) mygui myview = do
|
||||
writeTVarIO (operationBuffer myview) (FMove . MP1 $ items)
|
||||
let sbmsg = case items of
|
||||
(item:[]) -> "Move buffer: " ++ P.fpToString (fullPathS item)
|
||||
_ -> "Move buffer: " ++ (show . length $ items)
|
||||
++ " items"
|
||||
popStatusbar mygui
|
||||
void $ pushStatusBar mygui sbmsg
|
||||
moveInit _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
||||
"No file selected!"
|
||||
|
||||
-- |Supposed to be used with 'withRows'. Initializes a file copy operation.
|
||||
copyInit :: [Item] -> MyGUI -> MyView -> IO ()
|
||||
copyInit [item] mygui myview = do
|
||||
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ item)
|
||||
let sbmsg = "Copy buffer: " ++ P.fpToString (fullPathS item)
|
||||
copyInit items@(_:_) mygui myview = do
|
||||
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ items)
|
||||
let sbmsg = case items of
|
||||
(item:[]) -> "Copy buffer: " ++ P.fpToString (fullPathS item)
|
||||
_ -> "Copy buffer: " ++ (show . length $ items)
|
||||
++ " items"
|
||||
popStatusbar mygui
|
||||
void $ pushStatusBar mygui sbmsg
|
||||
copyInit _ _ _ = withErrorDialog
|
||||
. throw $ InvalidOperation
|
||||
"Operation not supported on multiple files"
|
||||
"No file selected!"
|
||||
|
||||
|
||||
-- |Finalizes a file operation, such as copy or move.
|
||||
@ -279,20 +285,24 @@ operationFinal _ myview = withErrorDialog $ do
|
||||
cdir <- getCurrentDir myview
|
||||
case op of
|
||||
FMove (MP1 s) -> do
|
||||
let cmsg = "Really move \"" ++ P.fpToString (fullPathS s)
|
||||
++ "\"" ++ " to \"" ++ P.fpToString (fullPathS cdir)
|
||||
let cmsg = "Really move " ++ imsg s
|
||||
++ " to \"" ++ P.fpToString (fullPathS cdir)
|
||||
++ "\"?"
|
||||
withConfirmationDialog cmsg . withCopyModeDialog
|
||||
$ \cm -> void $ runFileOp (FMove . MC s cdir $ cm)
|
||||
return ()
|
||||
FCopy (CP1 s) -> do
|
||||
let cmsg = "Really copy \"" ++ P.fpToString (fullPathS s)
|
||||
++ "\"" ++ " to \"" ++ P.fpToString (fullPathS cdir)
|
||||
let cmsg = "Really copy " ++ imsg s
|
||||
++ " to \"" ++ P.fpToString (fullPathS cdir)
|
||||
++ "\"?"
|
||||
withConfirmationDialog cmsg . withCopyModeDialog
|
||||
$ \cm -> void $ runFileOp (FCopy . CC s cdir $ cm)
|
||||
return ()
|
||||
_ -> return ()
|
||||
where
|
||||
imsg s = case s of
|
||||
(item:[]) -> "\"" ++ P.fpToString (fullPathS item) ++ "\""
|
||||
items -> (show . length $ items) ++ " items"
|
||||
|
||||
|
||||
-- |Go up one directory and visualize it in the treeView.
|
||||
|
Loading…
Reference in New Issue
Block a user