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

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)
+data Copy = CP1 [AnchoredFile FileInfo]
-          | CP2 (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)
+data Move = MP1 [AnchoredFile FileInfo]
-          | MC  (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 (CC froms to cm)) = mapM_ (\x -> easyCopy cm x to) froms
-runFileOp (FCopy fo)              = return              $ Just $ FCopy fo
+                                       >> return Nothing
-runFileOp (FMove (MC from to cm)) = moveFile cm from to >> return Nothing
+runFileOp (FCopy fo)               = return              $ Just $ FCopy fo
-runFileOp (FMove fo)              = return              $ Just $ FMove fo
+runFileOp (FMove (MC froms to cm)) = mapM_ (\x -> moveFile cm x to) froms
-runFileOp (FDelete fp)            = easyDelete fp       >> return Nothing
+                                       >> return Nothing
-runFileOp (FOpen fp)              = openFile fp         >> return Nothing
+runFileOp (FMove fo)               = return              $ Just $ FMove fo
-runFileOp (FExecute fp args)      = executeFile fp args >> return Nothing
+runFileOp (FDelete fp)             = mapM_ easyDelete fp >> return Nothing
-runFileOp _                       = 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"
 
 

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
+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
   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
+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
   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)
+      let cmsg = "Really move " ++ imsg s
-                  ++ "\"" ++ " to \"" ++ P.fpToString (fullPathS cdir)
+                  ++ " 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)
+      let cmsg = "Really copy " ++ imsg s
-                 ++ "\"" ++ " to \"" ++ P.fpToString (fullPathS cdir)
+                 ++ " 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.