95 lines
2.5 KiB
Haskell
95 lines
2.5 KiB
Haskell
{-# OPTIONS_HADDOCK ignore-exports #-}
|
|
|
|
module GUI.Gtk.Dialogs where
|
|
|
|
|
|
import Control.Exception
|
|
(
|
|
try
|
|
, SomeException
|
|
)
|
|
import Control.Monad
|
|
(
|
|
when
|
|
, void
|
|
)
|
|
|
|
import Graphics.UI.Gtk
|
|
import GUI.Gtk.Data
|
|
import IO.File
|
|
|
|
|
|
|
|
|
|
|
|
---------------------
|
|
--[ Dialog popups ]--
|
|
---------------------
|
|
|
|
|
|
-- |Pops up an error Dialog with the given String.
|
|
showErrorDialog :: String -> IO ()
|
|
showErrorDialog str = do
|
|
errorDialog <- messageDialogNew Nothing
|
|
[DialogDestroyWithParent]
|
|
MessageError
|
|
ButtonsClose
|
|
str
|
|
_ <- dialogRun errorDialog
|
|
widgetDestroy errorDialog
|
|
|
|
|
|
-- |Asks the user for confirmation and returns True/False.
|
|
showConfirmationDialog :: String -> IO Bool
|
|
showConfirmationDialog str = do
|
|
confirmDialog <- messageDialogNew Nothing
|
|
[DialogDestroyWithParent]
|
|
MessageQuestion
|
|
ButtonsYesNo
|
|
str
|
|
rID <- dialogRun confirmDialog
|
|
widgetDestroy confirmDialog
|
|
case rID of
|
|
ResponseYes -> return True
|
|
ResponseNo -> return False
|
|
_ -> return False
|
|
|
|
|
|
-- |Asks the user which directory copy mode he wants via dialog popup
|
|
-- and returns 'DirCopyMode'.
|
|
showCopyModeChooserDialog :: IO DirCopyMode
|
|
showCopyModeChooserDialog = do
|
|
chooserDialog <- messageDialogNew Nothing
|
|
[DialogDestroyWithParent]
|
|
MessageQuestion
|
|
ButtonsNone
|
|
"Choose the copy mode"
|
|
dialogAddButton chooserDialog "Strict" (ResponseUser 0)
|
|
dialogAddButton chooserDialog "Merge" (ResponseUser 1)
|
|
dialogAddButton chooserDialog "Replace" (ResponseUser 2)
|
|
rID <- dialogRun chooserDialog
|
|
widgetDestroy chooserDialog
|
|
case rID of
|
|
ResponseUser 0 -> return Strict
|
|
ResponseUser 1 -> return Merge
|
|
ResponseUser 2 -> return Replace
|
|
|
|
|
|
-- |Carry out an IO action with a confirmation dialog.
|
|
-- If the user presses "No", then do nothing.
|
|
withConfirmationDialog :: String -> IO () -> IO ()
|
|
withConfirmationDialog str io = do
|
|
run <- showConfirmationDialog str
|
|
when run io
|
|
|
|
|
|
-- |Execute the given IO action. If the action throws exceptions,
|
|
-- visualize them via 'showErrorDialog'.
|
|
withErrorDialog :: IO a -> IO ()
|
|
withErrorDialog io = do
|
|
r <- try io
|
|
either (\e -> showErrorDialog $ show (e :: SomeException))
|
|
(\_ -> return ())
|
|
r
|
|
|