{-# LANGUAGE FunctionalDependencies, KindSignatures, MultiParamTypeClasses #-} module Graphics.UI.AF.General.Dialog ( Dialog(..) ) where import Graphics.UI.AF.General.AutoForm import Graphics.UI.AF.General.Misc import Graphics.UI.AF.General.MySYB class ( AutoForm action comH builder satCxt com ) => Dialog (action :: * -> *) (comH :: * -> *) (builder :: * -> *) (satCxt :: * -> *) (com :: * -> *) | action -> comH, comH -> builder, builder -> satCxt, satCxt -> com, com -> action where settingsDialog :: ( TypePresentation a action comH builder satCxt com , Eq a, Sat (satCxt a)) => a -> Maybe (a -> action ()) -- ^Apply. However, this parameter may be ignored by a given instance. -- If Nohting then there will be no apply button. -> (a -> action ()) -- ^OK -> action () -- ^Canel -> action () settingsDialog = settingsDialogImpl -- |Creates a blocking window. blockingWindow :: TypePresentation b action comH builder satCxt com => ((Maybe b -> action ()) -> com a) -> action (Maybe b) -- |Blocking version of 'settingsDialog'. blockingSettingsDialog :: ( TypePresentation a action comH builder satCxt com , Sat (satCxt a)) => a -> action (Maybe a) blockingSettingsDialog = blockingSettingsDialogImpl settingsDialogImpl :: ( AutoForm action comH builder satCxt com , TypePresentation a action comH builder satCxt com , Sat (satCxt a), Eq a) => a -> Maybe (a -> action ()) -> (a -> action ()) -> action () -> action () settingsDialogImpl com apply ok cancel = window $ builderToCom $ do entryHandle <- builderCom com chState <- makeChangedState entryHandle case apply of Nothing -> return () Just apply' -> do button "Apply" (getValue entryHandle >>= apply') >>= enabledWhen chState (== Changed) return () button "OK" (getValue entryHandle >>= ok) >>= enabledWhen chState (== Changed) button "Canel" cancel return entryHandle blockingSettingsDialogImpl :: ( AutoForm action comH builder satCxt com , Dialog action comH builder satCxt com , TypePresentation a action comH builder satCxt com , Sat (satCxt a)) => a -> action (Maybe a) blockingSettingsDialogImpl com = blockingWindow (builderToCom . helper) where helper stop = do entryHandle <- builderCom com button "OK" (getValue entryHandle >>= stop . Just) button "Canel" (stop Nothing)