hsfm/src/GUI/Gtk/Dialogs.hs

{-# 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


-- |Shows the about dialog from the help menu.
showAboutDialog :: IO ()
showAboutDialog = do
  ad <- aboutDialogNew
  licensestr <- readFile "LICENSE"
  hsfmicon <- pixbufNewFromFile "data/Gtk/icons/hsfm.png"
  set ad
    [ aboutDialogProgramName  := "hsfm"
    , aboutDialogName         := "hsfm"
    , aboutDialogVersion      := "0.0.0.1"
    , aboutDialogCopyright    := "Copyright: (c) 2015 Julian Ospald"
    , aboutDialogComments     := "A file manager written in Haskell"
    , aboutDialogLicense      := Just licensestr
    , aboutDialogWebsite      := "https://github.com/hasufell/hsfm"
    , aboutDialogAuthors      := ["Julian Ospald <hasufell@hasufell.de>"]
    , aboutDialogLogo         := Just hsfmicon
    , aboutDialogWrapLicense  := True
    ]
  _ <- dialogRun ad
  widgetDestroy ad


-- |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