Dialog.hs

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