CloseIDE.hs

-- | Condition: The program ends when the main window is closed

module Controller.Conditions.CloseIDE
    (installCondition)
  where

-- External libraries
import Control.Arrow
import Control.Monad
import Control.Monad.Reader (liftIO)
import Graphics.UI.Gtk

-- Internal libraries
import CombinedEnvironment hiding (installCondition)
import View.Objects

-- TODO:
-- filter :: (a -> Bool) -> RV a -> RV a
-- only changes when f a == True
--
-- edge :: (a -> Bool) -> RV a -> RV a
-- only changes when f a becomes True after being False
--
-- also filterM and edgeM
--
-- liftIO :: m a -> RO a m
--
-- wrapIO :: m a -> (a -> m ()) -> RV a m -- Passive
--
-- The following probably exists already:
-- wrapWO :: (a -> m b) -> RV a
--

installCondition :: CEnv -> IO()
installCondition cenv = void $ do
  mw <- mainWindow $ uiBuilder $ view cenv
  mw `on` deleteEvent $ liftIO $ conditionVM cenv

-- | Enforces the condition in View to Model direction
conditionVM :: CEnv -> IO Bool
conditionVM cenv = do
  b <- checkExit cenv
  when b $ onViewAsync destroyView
  return (not b)

-- Returns true if the operation can continue, false otherwise
checkExit :: CEnv -> IO Bool
checkExit cenv = do
  let (v,m) = (view &&& model) cenv
  let ui = uiBuilder v
  win <- mainWindow ui
  dialog <- messageDialogNew (Just win) [DialogModal] MessageQuestion ButtonsNone
              "Exit?"
  dialogAddButton dialog "Cancel"               ResponseCancel
  dialogAddButton dialog "Exit"                 ResponseYes

  dialogSetDefaultResponse dialog ResponseCancel

  -- Run the dialog and process the result
  widgetShowAll dialog
  r <- dialogRun dialog
  res <- case r of
           ResponseYes -> return True
           _           -> return False -- Cancel or close the dialog without answering
  widgetDestroy dialog
  return res