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
-- and returns 'DirCopyMode'.
-- and returns 'DirCopyMode'. Default is always Strict, so this allows
-- switching to Merge/Replace/Rename.
showCopyModeDialog :: IO (Maybe CopyMode)
showCopyModeDialog = do
chooserDialog <- messageDialogNew Nothing
@ -117,7 +118,7 @@ showCopyModeDialog = do
rID <- dialogRun chooserDialog
widgetDestroy chooserDialog
case rID of
ResponseUser 0 -> return (Just Strict)
ResponseUser 0 -> return Nothing
ResponseUser 1 -> return (Just Merge)
ResponseUser 2 -> return (Just Replace)
ResponseUser 3 -> do
@ -128,6 +129,29 @@ showCopyModeDialog = do
_ -> 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.
-- If that raises a `FileDoesExist` or `DirDoesExist`, then it prompts
-- the user for action via `showCopyModeDialog` and then carries out
@ -136,16 +160,17 @@ withCopyModeDialog :: (CopyMode -> IO ()) -> IO ()
withCopyModeDialog fa =
catch (fa Strict) $ \e ->
case e of
FileDoesExist _ -> doIt
DirDoesExist _ -> doIt
SameFile _ _ -> doIt
FileDoesExist _ -> doIt showCopyModeDialog
DirDoesExist _ -> doIt showCopyModeDialog
SameFile _ _ -> doIt showRenameDialog
e' -> throw e'
where
doIt = do mcm <- showCopyModeDialog
case mcm of
(Just Strict) -> return () -- don't try again
(Just cm) -> fa cm
Nothing -> return ()
doIt getCm = do
mcm <- getCm
case mcm of
(Just Strict) -> return () -- don't try again
(Just cm) -> fa cm
Nothing -> return ()
-- |Shows the about dialog from the help menu.