GTK: fixup withCopyModeDialog

By adding a more specialized showRenameDialog function
and also cleaning up the responses/return values for
showCopyModeDialog.
This commit is contained in:
Julian Ospald 2016-04-09 17:38:38 +02:00
parent 44a90574e8
commit 1be8984162
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
1 changed files with 35 additions and 10 deletions

View File

@ -102,7 +102,8 @@ showConfirmationDialog str = do
-- |Asks the user which directory copy mode he wants via dialog popup -- |Asks the user which directory copy mode he wants via dialog popup
-- and returns 'DirCopyMode'. -- and returns 'DirCopyMode'. Default is always Strict, so this allows
-- switching to Merge/Replace/Rename.
showCopyModeDialog :: IO (Maybe CopyMode) showCopyModeDialog :: IO (Maybe CopyMode)
showCopyModeDialog = do showCopyModeDialog = do
chooserDialog <- messageDialogNew Nothing chooserDialog <- messageDialogNew Nothing
@ -117,7 +118,7 @@ showCopyModeDialog = do
rID <- dialogRun chooserDialog rID <- dialogRun chooserDialog
widgetDestroy chooserDialog widgetDestroy chooserDialog
case rID of case rID of
ResponseUser 0 -> return (Just Strict) ResponseUser 0 -> return Nothing
ResponseUser 1 -> return (Just Merge) ResponseUser 1 -> return (Just Merge)
ResponseUser 2 -> return (Just Replace) ResponseUser 2 -> return (Just Replace)
ResponseUser 3 -> do ResponseUser 3 -> do
@ -128,6 +129,29 @@ showCopyModeDialog = do
_ -> throw UnknownDialogButton _ -> throw UnknownDialogButton
-- |Stipped version of `showCopyModeDialog` that only allows cancelling
-- or Renaming.
showRenameDialog :: IO (Maybe CopyMode)
showRenameDialog = do
chooserDialog <- messageDialogNew Nothing
[DialogDestroyWithParent]
MessageQuestion
ButtonsNone
"Target exists, how to proceed?"
_ <- dialogAddButton chooserDialog "Cancel" (ResponseUser 0)
_ <- dialogAddButton chooserDialog "Rename" (ResponseUser 1)
rID <- dialogRun chooserDialog
widgetDestroy chooserDialog
case rID of
ResponseUser 0 -> return Nothing
ResponseUser 1 -> do
mfn <- textInputDialog "Enter new name"
forM mfn $ \fn -> do
pfn <- P.parseFn (P.userStringToFP fn)
return $ Rename pfn
_ -> throw UnknownDialogButton
-- |Attempts to run the given function with the `Strict` copy mode. -- |Attempts to run the given function with the `Strict` copy mode.
-- If that raises a `FileDoesExist` or `DirDoesExist`, then it prompts -- If that raises a `FileDoesExist` or `DirDoesExist`, then it prompts
-- the user for action via `showCopyModeDialog` and then carries out -- the user for action via `showCopyModeDialog` and then carries out
@ -136,16 +160,17 @@ withCopyModeDialog :: (CopyMode -> IO ()) -> IO ()
withCopyModeDialog fa = withCopyModeDialog fa =
catch (fa Strict) $ \e -> catch (fa Strict) $ \e ->
case e of case e of
FileDoesExist _ -> doIt FileDoesExist _ -> doIt showCopyModeDialog
DirDoesExist _ -> doIt DirDoesExist _ -> doIt showCopyModeDialog
SameFile _ _ -> doIt SameFile _ _ -> doIt showRenameDialog
e' -> throw e' e' -> throw e'
where where
doIt = do mcm <- showCopyModeDialog doIt getCm = do
case mcm of mcm <- getCm
(Just Strict) -> return () -- don't try again case mcm of
(Just cm) -> fa cm (Just Strict) -> return () -- don't try again
Nothing -> return () (Just cm) -> fa cm
Nothing -> return ()
-- |Shows the about dialog from the help menu. -- |Shows the about dialog from the help menu.