LIB/GTK: add convenient renaming capabilities on file copy/move

src/HSFM/FileSystem/FileOperations.hs

@@ -139,6 +139,7 @@ data CopyMode = Strict  -- ^ fail if the target already exists
                         --   is the same as Replace
               | Replace -- ^ remove targets before copying, this is
                         --   only useful if the target is a directorty
+              | Rename (Path Fn)
 
 
 -- |Run a given FileOperation. If the FileOperation is partial, it will
@@ -147,7 +148,7 @@ runFileOp :: FileOperation -> IO (Maybe FileOperation)
 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
+runFileOp (FMove (MC froms to cm)) = mapM_ (\x -> easyMove cm x to) froms
                                        >> return Nothing
 runFileOp (FMove fo)               = return              $ Just $ FMove fo
 runFileOp (FDelete fp)             = mapM_ easyDelete fp >> return Nothing
@@ -162,7 +163,6 @@ runFileOp _                        = return Nothing
     --------------------
 
 
--- TODO: allow renaming
 -- |Copies a directory to the given destination with the specified
 -- `DirCopyMode`. Excludes symlinks.
 copyDir :: CopyMode
@@ -173,6 +173,12 @@ copyDir :: CopyMode
 copyDir _ AFileInvFN _ _ = throw InvalidFileName
 copyDir _ _ AFileInvFN _ = throw InvalidFileName
 copyDir _ _ _ InvFN      = throw InvalidFileName
+copyDir       (Rename fn)
+         from@(_ :/ Dir {})
+           to@(_ :/ Dir {})
+           _
+  = copyDir Strict from to fn
+-- this branch must never get `Rename` as CopyMode
 copyDir cm from@(_ :/ Dir _ FileInfo{ fileMode = fmode })
              to@(_ :/ Dir {})
              fn
@@ -211,6 +217,7 @@ copyDir cm from@(_ :/ Dir _ FileInfo{ fileMode = fmode })
                 (deleteDirRecursive =<<
                    HSFM.FileSystem.FileType.readFileWithFileInfo destdir)
           createDirectory destdir' fmode'
+        _ -> throw $ InvalidOperation "Internal error, wrong CopyMode!"
 copyDir _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
@@ -224,6 +231,8 @@ recreateSymlink :: CopyMode
 recreateSymlink _ AFileInvFN _ _ = throw InvalidFileName
 recreateSymlink _ _ AFileInvFN _ = throw InvalidFileName
 recreateSymlink _ _ _ InvFN      = throw InvalidFileName
+recreateSymlink (Rename pn) symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) _
+  = recreateSymlink Strict symf symdest pn
 recreateSymlink cm symf@(_ :/ SymLink {}) symdest@(_ :/ Dir {}) fn
   = do
     throwCantOpenDirectory $ fullPath symdest
@@ -253,6 +262,8 @@ copyFile :: CopyMode
 copyFile _ AFileInvFN _ _ = throw InvalidFileName
 copyFile _ _ AFileInvFN _ = throw InvalidFileName
 copyFile _ _ _ InvFN      = throw InvalidFileName
+copyFile (Rename pn) from@(_ :/ RegFile {}) to@(_ :/ Dir {}) _
+  = copyFile Strict from to pn
 copyFile cm from@(_ :/ RegFile {}) to@(_ :/ Dir {}) fn
   = do
     let from' = fullPath from
@@ -436,18 +447,22 @@ renameFile _ _ = throw $ InvalidOperation "wrong input type"
 moveFile :: CopyMode
          -> AnchoredFile FileInfo -- ^ file to move
          -> AnchoredFile FileInfo -- ^ base target directory
+         -> Path Fn               -- ^ target file name
          -> IO ()
-moveFile _ AFileInvFN _ = throw InvalidFileName
+moveFile _ AFileInvFN _ _ = throw InvalidFileName
-moveFile _ _ AFileInvFN = throw InvalidFileName
+moveFile _ _ AFileInvFN _ = throw InvalidFileName
-moveFile cm from to@(_ :/ Dir {}) = do
+moveFile (Rename pn) from to@(_ :/ Dir {}) _ =
+  moveFile Strict from to pn
+moveFile cm from to@(_ :/ Dir {}) fn = do
   let from'  = fullPath from
       froms' = fullPathS from
-      to'    = fullPath to P.</> (name . file $ from)
+      to'    = fullPath to P.</> fn
-      tos'   = P.fromAbs (fullPath to P.</> (name . file $ from))
+      tos'   = P.fromAbs (fullPath to P.</> fn)
   case cm of
-    Strict  -> throwFileDoesExist to'
+    Strict   -> throwFileDoesExist to'
-    Merge   -> delOld to'
+    Merge    -> delOld to'
-    Replace -> delOld to'
+    Replace  -> delOld to'
+    Rename _ -> throw $ InvalidOperation "Internal error! Wrong CopyMode!"
   throwSameFile from' to'
   catchErrno eXDEV (rename froms' tos') $ do
     easyCopy Strict from to
@@ -456,9 +471,15 @@ moveFile cm from to@(_ :/ Dir {}) = do
     delOld fp = do
       to' <- HSFM.FileSystem.FileType.readFileWithFileInfo fp
       unless (failed . file $ to') (easyDelete to')
-moveFile _ _ _ = throw $ InvalidOperation "wrong input type"
+moveFile _ _ _ _ = throw $ InvalidOperation "wrong input type"
 
 
+-- |Like `moveFile` except it uses the filename of the source as target.
+easyMove :: CopyMode
+         -> AnchoredFile FileInfo -- ^ file to move
+         -> AnchoredFile FileInfo -- ^ base target directory
+         -> IO ()
+easyMove cm from to = moveFile cm from to (name . file $ from)
 
 
 

src/HSFM/GUI/Gtk/Dialogs.hs

@@ -30,7 +30,8 @@ import Control.Exception
   )
 import Control.Monad
   (
-    when
+    forM
+  , when
   )
 import Data.Version
   (
@@ -55,6 +56,7 @@ import Distribution.Verbosity
     silent
   )
 import Graphics.UI.Gtk
+import qualified HPath as P
 import HSFM.FileSystem.Errors
 import HSFM.FileSystem.FileOperations
 import HSFM.GUI.Gtk.Errors
@@ -101,7 +103,7 @@ showConfirmationDialog str = do
 
 -- |Asks the user which directory copy mode he wants via dialog popup
 -- and returns 'DirCopyMode'.
-showCopyModeDialog :: IO CopyMode
+showCopyModeDialog :: IO (Maybe CopyMode)
 showCopyModeDialog = do
   chooserDialog <- messageDialogNew Nothing
                                     [DialogDestroyWithParent]
@@ -111,12 +113,18 @@ showCopyModeDialog = do
   _ <- dialogAddButton chooserDialog "Cancel"  (ResponseUser 0)
   _ <- dialogAddButton chooserDialog "Merge"   (ResponseUser 1)
   _ <- dialogAddButton chooserDialog "Replace" (ResponseUser 2)
+  _ <- dialogAddButton chooserDialog "Rename"  (ResponseUser 3)
   rID <- dialogRun chooserDialog
   widgetDestroy chooserDialog
   case rID of
-    ResponseUser 0 -> return Strict
+    ResponseUser 0 -> return (Just Strict)
-    ResponseUser 1 -> return Merge
+    ResponseUser 1 -> return (Just Merge)
-    ResponseUser 2 -> return Replace
+    ResponseUser 2 -> return (Just Replace)
+    ResponseUser 3 -> do
+      mfn   <- textInputDialog "Enter new name"
+      forM mfn $ \fn -> do
+        pfn <- P.parseFn (P.userStringToFP fn)
+        return $ Rename pfn
     _              -> throw  UnknownDialogButton
 
 
@@ -130,12 +138,14 @@ withCopyModeDialog fa =
     case e of
       FileDoesExist _ -> doIt
       DirDoesExist  _ -> doIt
+      SameFile _ _    -> doIt
       e'              -> throw e'
   where
-    doIt = do cm <- showCopyModeDialog
+    doIt = do mcm <- showCopyModeDialog
-              case cm of
+              case mcm of
-                Strict -> return () -- don't try again
+                (Just Strict) -> return () -- don't try again
-                _      -> fa cm
+                (Just cm)     -> fa cm
+                Nothing       -> return ()
 
 
 -- |Shows the about dialog from the help menu.