LIB/GTK: implement copy/move/delete for multiple files

This commit is contained in:
Julian Ospald 2016-04-09 15:15:05 +02:00
parent 418365db0f
commit 478ffa0e98
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
2 changed files with 38 additions and 27 deletions

View File

@ -109,7 +109,7 @@ import System.Posix.Types
-- or delay operations. -- or delay operations.
data FileOperation = FCopy Copy data FileOperation = FCopy Copy
| FMove Move | FMove Move
| FDelete (AnchoredFile FileInfo) | FDelete [AnchoredFile FileInfo]
| FOpen (AnchoredFile FileInfo) | FOpen (AnchoredFile FileInfo)
| FExecute (AnchoredFile FileInfo) [ByteString] | FExecute (AnchoredFile FileInfo) [ByteString]
| None | None
@ -117,18 +117,18 @@ data FileOperation = FCopy Copy
-- |Data type describing partial or complete file copy operation. -- |Data type describing partial or complete file copy operation.
-- CC stands for a complete operation and can be used for `runFileOp`. -- CC stands for a complete operation and can be used for `runFileOp`.
data Copy = CP1 (AnchoredFile FileInfo) data Copy = CP1 [AnchoredFile FileInfo]
| CP2 (AnchoredFile FileInfo) | CP2 [AnchoredFile FileInfo]
(AnchoredFile FileInfo) (AnchoredFile FileInfo)
| CC (AnchoredFile FileInfo) | CC [AnchoredFile FileInfo]
(AnchoredFile FileInfo) (AnchoredFile FileInfo)
CopyMode CopyMode
-- |Data type describing partial or complete file move operation. -- |Data type describing partial or complete file move operation.
-- MC stands for a complete operation and can be used for `runFileOp`. -- MC stands for a complete operation and can be used for `runFileOp`.
data Move = MP1 (AnchoredFile FileInfo) data Move = MP1 [AnchoredFile FileInfo]
| MC (AnchoredFile FileInfo) | MC [AnchoredFile FileInfo]
(AnchoredFile FileInfo) (AnchoredFile FileInfo)
CopyMode 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 -- |Run a given FileOperation. If the FileOperation is partial, it will
-- be returned. -- be returned.
runFileOp :: FileOperation -> IO (Maybe FileOperation) 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 (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 (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 (FOpen fp) = openFile fp >> return Nothing
runFileOp (FExecute fp args) = executeFile fp args >> return Nothing runFileOp (FExecute fp args) = executeFile fp args >> return Nothing
runFileOp _ = return Nothing runFileOp _ = return Nothing
@ -268,7 +270,6 @@ copyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
$ System.Posix.Files.ByteString.fileMode fromFstatus) $ System.Posix.Files.ByteString.fileMode fromFstatus)
SPI.closeFd SPI.closeFd
(\fd -> void $ fdWrite fd fromContent) (\fd -> void $ fdWrite fd fromContent)
copyFile _ _ _ _ = throw $ InvalidOperation "wrong input type" copyFile _ _ _ _ = throw $ InvalidOperation "wrong input type"

View File

@ -251,25 +251,31 @@ del _ _ _ = withErrorDialog
-- |Initializes a file move operation. -- |Initializes a file move operation.
moveInit :: [Item] -> MyGUI -> MyView -> IO () moveInit :: [Item] -> MyGUI -> MyView -> IO ()
moveInit [item] mygui myview = do moveInit items@(_:_) mygui myview = do
writeTVarIO (operationBuffer myview) (FMove . MP1 $ item) writeTVarIO (operationBuffer myview) (FMove . MP1 $ items)
let sbmsg = "Move buffer: " ++ P.fpToString (fullPathS item) let sbmsg = case items of
(item:[]) -> "Move buffer: " ++ P.fpToString (fullPathS item)
_ -> "Move buffer: " ++ (show . length $ items)
++ " items"
popStatusbar mygui popStatusbar mygui
void $ pushStatusBar mygui sbmsg void $ pushStatusBar mygui sbmsg
moveInit _ _ _ = withErrorDialog moveInit _ _ _ = withErrorDialog
. throw $ InvalidOperation . throw $ InvalidOperation
"Operation not supported on multiple files" "No file selected!"
-- |Supposed to be used with 'withRows'. Initializes a file copy operation. -- |Supposed to be used with 'withRows'. Initializes a file copy operation.
copyInit :: [Item] -> MyGUI -> MyView -> IO () copyInit :: [Item] -> MyGUI -> MyView -> IO ()
copyInit [item] mygui myview = do copyInit items@(_:_) mygui myview = do
writeTVarIO (operationBuffer myview) (FCopy . CP1 $ item) writeTVarIO (operationBuffer myview) (FCopy . CP1 $ items)
let sbmsg = "Copy buffer: " ++ P.fpToString (fullPathS item) let sbmsg = case items of
(item:[]) -> "Copy buffer: " ++ P.fpToString (fullPathS item)
_ -> "Copy buffer: " ++ (show . length $ items)
++ " items"
popStatusbar mygui popStatusbar mygui
void $ pushStatusBar mygui sbmsg void $ pushStatusBar mygui sbmsg
copyInit _ _ _ = withErrorDialog copyInit _ _ _ = withErrorDialog
. throw $ InvalidOperation . throw $ InvalidOperation
"Operation not supported on multiple files" "No file selected!"
-- |Finalizes a file operation, such as copy or move. -- |Finalizes a file operation, such as copy or move.
@ -279,20 +285,24 @@ operationFinal _ 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.fpToString (fullPathS s) let cmsg = "Really move " ++ imsg s
++ "\"" ++ " to \"" ++ P.fpToString (fullPathS cdir) ++ " to \"" ++ P.fpToString (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.fpToString (fullPathS s) let cmsg = "Really copy " ++ imsg s
++ "\"" ++ " to \"" ++ P.fpToString (fullPathS cdir) ++ " to \"" ++ P.fpToString (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 ()
_ -> 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. -- |Go up one directory and visualize it in the treeView.