From 478ffa0e98b8340d2d04f74a7f4eb5f492412591 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Sat, 9 Apr 2016 15:15:05 +0200 Subject: [PATCH] LIB/GTK: implement copy/move/delete for multiple files --- src/HSFM/FileSystem/FileOperations.hs | 31 ++++++++++++------------ src/HSFM/GUI/Gtk/Callbacks.hs | 34 +++++++++++++++++---------- 2 files changed, 38 insertions(+), 27 deletions(-) diff --git a/src/HSFM/FileSystem/FileOperations.hs b/src/HSFM/FileSystem/FileOperations.hs index 52ea1a4..05d504b 100644 --- a/src/HSFM/FileSystem/FileOperations.hs +++ b/src/HSFM/FileSystem/FileOperations.hs @@ -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,14 +144,16 @@ 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 fo) = return $ Just $ FCopy fo -runFileOp (FMove (MC from to cm)) = moveFile cm from to >> return Nothing -runFileOp (FMove fo) = return $ Just $ FMove fo -runFileOp (FDelete fp) = easyDelete fp >> return Nothing -runFileOp (FOpen fp) = openFile fp >> return Nothing -runFileOp (FExecute fp args) = executeFile fp args >> return Nothing -runFileOp _ = 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 froms to cm)) = mapM_ (\x -> moveFile cm x to) froms + >> return Nothing +runFileOp (FMove fo) = return $ Just $ FMove fo +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" diff --git a/src/HSFM/GUI/Gtk/Callbacks.hs b/src/HSFM/GUI/Gtk/Callbacks.hs index 1d85967..22e4794 100644 --- a/src/HSFM/GUI/Gtk/Callbacks.hs +++ b/src/HSFM/GUI/Gtk/Callbacks.hs @@ -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.