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.
|
-- 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"
|
||||||
|
|
||||||
|
|
||||||
|
@ -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.
|
||||||
|
Loading…
Reference in New Issue
Block a user