content: {-# LANGUAGE ScopedTypeVariables #-}
  -- | Publishes the main elements of a scale as reactive fields
  --
  -- Copyright   : (C) Keera Studios Ltd, 2013
  -- License     : BSD3
  -- Maintainer  : support@keera.co.uk
  module Graphics.UI.Gtk.Reactive.Property where
  
  import Control.Monad (void, when)
  import Control.Monad.IO.Class
  import Graphics.UI.Gtk
  import Data.ReactiveValue
  
  -- * Attributes as reactive values
  
  -- ** Signal-based reactimation functions.
  
  -- | Create an RV based on a widget's attribute and signal. Before setting,
  -- the value is checked against the current one. If they are the same, the
  -- value is *not* set.
  reactiveProperty :: Eq b
                   => self
                   -> Signal self (IO ()) -> Attr self b
                   -> ReactiveFieldReadWrite IO b
  reactiveProperty e sig attr =
    ReactiveFieldReadWrite setter getter notifier
   where getter     = get e attr
         setter v   = postGUIAsync $ do
                        p <- getter
                        when (p /= v) $ set e [ attr := v ]
         notifier p = void (on e sig p)
  
  -- | Create an RV based on a widget's attribute and signal.
  -- Before setting, the value is *not* checked against the current one.
  -- The value is thus set even if they are the same.
  reactivePropertyNE :: self
                     -> Signal self (IO ()) -> Attr self b
                     -> ReactiveFieldReadWrite IO b
  reactivePropertyNE e sig attr =
    ReactiveFieldReadWrite setter getter notifier
   where getter     = get e attr
         setter v   = postGUIAsync $ set e [ attr := v ]
         notifier p = void (on e sig p)
  
  reactiveSignalIO :: self
                   -> Signal self (IO ())
                   -> ReactiveFieldRead IO ()
  reactiveSignalIO e sig =
    ReactiveFieldRead getter notifier
   where getter     = return ()
         notifier p = void (on e sig p)
  
  reactiveSignalM :: (Monad m, MonadIO m)
                  => self
                  -> a
                  -> Signal self (m a)
                  -> ReactiveFieldRead IO ()
  reactiveSignalM e def sig =
    ReactiveFieldRead getter notifier
   where getter     = return ()
         notifier p = void (on e sig (liftIO p >> return def))
  
  
  -- ** Handler-based reactimation functions
  
  -- | Create an RV based on a widget's attribute and a handler.
  -- Before setting, the value is checked against the current one.
  -- If they are the same, the value is *not* set.
  reactivePropertyH :: Eq b
                    => self
                    -> (self -> IO () -> IO (ConnectId self)) -> Attr self b
                    -> ReactiveFieldReadWrite IO b
  reactivePropertyH e sig attr =
    ReactiveFieldReadWrite setter getter notifier
   where getter     = get e attr
         setter v   = postGUIAsync $ do
                        p <- getter
                        when (p /= v) $ set e [ attr := v ]
         notifier p = void (e `sig` p)
  
  -- | Create a unit read-only RV based on a widget's event handler.
  reactivePropertyH_ :: self
                     -> (self -> IO () -> IO (ConnectId self))
                     -> ReactiveFieldRead IO ()
  reactivePropertyH_ e sig =
    ReactiveFieldRead getter notifier
   where getter     = return ()
         notifier p = void (e `sig` p)
  
  -- * Passive properties
  
  -- | A passive reactive value is one that does not report when it changes.
  --
  -- This function returns a RW RV that encloses the given property, without
  -- firing change events. The value of the attribute is *not* set if it is the
  -- same as the current one.
  --
  -- To set without diffing, see 'passivePropertyNE'.
  passiveProperty :: Eq b
                   => self
                   -> Attr self b
                   -> ReactiveFieldReadWrite IO b
  passiveProperty e attr =
    ReactiveFieldReadWrite setter getter notifier
   where getter     = get e attr
         setter v   = postGUIAsync $ do
                        p <- getter
                        when (p /= v) $ set e [ attr := v ]
         notifier _ = return ()
  
  -- | Return a RW RV that encloses the given property, without firing change
  -- events.
  --
  -- When writing to this RV, the value is *not* diffed against the previous one.
  -- The underlying widget can thus still fire signals based on that change.
  passivePropertyNE :: self
                    -> Attr self b
                    -> ReactiveFieldReadWrite IO b
  passivePropertyNE e attr =
    ReactiveFieldReadWrite setter getter notifier
   where getter     = get e attr
         setter v   = postGUIAsync $ set e [ attr := v ]
         notifier _ = return ()
  
  passivePropertyGE :: Eq b
                   => self
                   -> (self -> b -> IO ()) -> (self -> IO b)
                   -> ReactiveFieldReadWrite IO b
  passivePropertyGE e set' get' =
    ReactiveFieldReadWrite setter getter notifier
   where getter     = get' e
         setter v   = postGUIAsync $ do
                        p <- getter
                        when (p /= v) $ set' e v
         notifier _ = return ()
  