{-# LANGUAGE CPP, ForeignFunctionInterface #-}
-- -*-haskell-*-
--

{- | Xfconf-GObject Binding -- Functions to bind Xfconf properties to
   GObject properties.

   Note that this haskell API follows closely the original C API. Object
   properties should be given using their string name from the C API
   and not their Haskell name deriving from
   'System.Glib.Attributes.ReadWriteAttr'.

   For more information, see:
   http:\/\/docs.xfce.org\/api\/xfconf\/xfconf-xfconf-binding.html
-}


#include <glib-object.h>
#include <xfconf/xfconf.h>

{# context lib="xfconf-0" prefix="xfconf" #}

module System.XFCE.Xfconf.Binding (
                -- * Detail
                -- $details

                -- * Example
                -- $example

                -- * Types
                XfconfBindingID,

                -- * Functions
                xfconfBind,
                xfconfBindGdkColor,
                xfconfUnbind,
                xfconfUnbindAll,
                xfconfUnbindByProperty,

                -- re-exports glib gtype constants
                module System.Glib.GTypeConstants

                ) where

import System.Glib.GObject    (GObject(GObject), GObjectClass(toGObject))
import System.Glib.GType      (GType)
import System.Glib.GTypeConstants
import System.Glib.UTFString

import System.XFCE.Xfconf.FFI
{#import System.XFCE.Xfconf.Types #}

{----------------------------------------------------------------------
-- Details
----------------------------------------------------------------------}

-- $details
-- Often it may be useful to bind an Xfconf property to a GObject
-- property. Settings dialogs often display the current value of an
-- Xfconf property, and a user may edit the value to change the value in
-- the Xfconf store. If the Xfconf property changes outside the settings
-- dialog, the user will usually want to see the settings dialog
-- automatically update to reflect the new value. With a single line
-- of code, Xfconf's binding functionality can automate all this.

{----------------------------------------------------------------------
-- Example (from Tests/Demo.hs)
----------------------------------------------------------------------}

-- $example
-- From the demo program in @\"Tests/Demo.hs\"@
--
-- @
-- chan \<- channelGet \"Demo\"
-- --
-- check0 \<- checkButtonNewWithLabel \"Check me \!\"
-- label0 \<- labelNew (Just \"\<null>\")
-- check1 \<- checkButtonNewWithLabel \"Check me !\"
-- --
-- let xfconf_property = \"\/check\"
-- \ \ \ \ obj_property    = \"active\"    -- toggleButtonActive attribute
-- --
-- -- Signals voodoo \\o\/
-- -- * bind check buttons from\/to xfconfd
-- -- * thus, their \"active\" state will remain synchronized
-- xfsig0 \<- xfconfBind chan xfconf_property bool check0 obj_property
-- xfsig1 \<- xfconfBind chan xfconf_property bool check1 obj_property
-- --
-- -- * monitor xfconfd and update the label accordingly
-- onPropertyChanged chan $ \\key maybeValue -> do
-- \ \ if key \/= xfconf_property
-- \ \ \ then return ()
-- \ \ \ else case maybeValue of
-- \ \ \ \ \ Just (XfconfBool True)  -> labelSetText label0 \"checked !\"
-- \ \ \ \ \ Just (XfconfBool False) -> labelSetText label0 \"unchecked !\"
-- \ \ \ \ \  _ -> labelSetText label0 \"UNKNOWN\"
-- --
-- -- Who cares about memory management nowadays ?
-- onDestroy window $ do
-- \ \ \ \ \ \ \ \ mainQuit
-- \ \ \ \ \ \ \ \ putStrLn \"ByeBye\"
-- @

{----------------------------------------------------------------------
-- Types and marshallers
----------------------------------------------------------------------}

-- | ID number that can be used to later remove corresponding bindings.
newtype XfconfBindingID = XfconfBindingID {unXfconfBindingID :: CULong}

-- | convenient marshall in function
withGObject :: GObjectClass obj => obj -> (Ptr () -> IO b) -> IO b
withGObject obj = let (GObject ptr) = toGObject obj
                  in withForeignPtr (castForeignPtr ptr)

{----------------------------------------------------------------------
-- Bindings
----------------------------------------------------------------------}

-- | Binds an Xfconf property to a GObject property. If the property is
-- changed via either the GObject or Xfconf, the corresponding property
-- will also be updated.
--
-- Note that @xfconf property type@ is required since @xfconf property@
-- may or may not already exist in the Xfconf store. The type of @object
-- property@ will be determined automatically. If the two types do not
-- match, a conversion will be attempted.
xfconfBind :: (XfconfChannelClass conf, GObjectClass obj)
           => conf               -- ^ channel
           -> String             -- ^ xfconf property
           -> GType              -- ^ xfconf property type
           -> obj                -- ^ object
           -> String             -- ^ object property
           -> IO XfconfBindingID -- ^ Xfconf binding ID
xfconfBind chan0 prop1 type2 obj3 prop4 =
    withUTFString prop1 $ \prop1' ->
    withGObject obj3 $ \obj3' ->
    withUTFString prop4 $ \prop4' ->
    let chan0' = toXfconfChannel chan0
        f = {#call unsafe g_property_bind #}
    in XfconfBindingID `fmap` f chan0' prop1' type2 obj3' prop4'

-- | Binds an Xfconf property to a GObject property of type
-- GDK_TYPE_COLOR (aka a GdkColor struct or simply 'Color' in Haskell
-- Pango library). If the property is changed via either the GObject or
-- Xfconf, the corresponding property will also be updated.
--
-- This is a special-case binding; the GdkColor struct is not ideal
-- as-is for binding to a property, so it is stored in the Xfconf store
-- as four 16-bit unsigned ints (red, green, blue, alpha). Since
-- GdkColor (currently) only supports RGB and not RGBA, the last value
-- will always be set to 0xFFFF.
xfconfBindGdkColor :: (XfconfChannelClass conf, GObjectClass obj)
                   => conf    -- ^ channel
                   -> String  -- ^ xfconf property
                   -> obj     -- ^ object
                   -> String  -- ^ object property
                   -> IO XfconfBindingID
xfconfBindGdkColor chan0 prop1 obj2 prop3 =
    withUTFString prop1 $ \prop1' ->
    withGObject obj2 $ \obj2' ->
    withUTFString prop3 $ \prop3' ->
    let chan0' = toXfconfChannel chan0
        f = {#call unsafe g_property_bind_gdkcolor #}
    in XfconfBindingID `fmap` f chan0' prop1' obj2' prop3'

-- | Removes an Xfconf/GObject property binding based on the binding
-- 'XfconfBindingID' number. See 'xfconfBind'.
xfconfUnbind :: XfconfBindingID -> IO ()
xfconfUnbind = {#call unsafe g_property_unbind #} . unXfconfBindingID

-- | Causes an Xfconf channel previously bound to a GObject property
-- (see 'xfconfBind') to no longer be bound.
xfconfUnbindByProperty :: (XfconfChannelClass conf, GObjectClass obj)
                       => conf    -- ^ channel
                       -> String  -- ^ channel property
                       -> obj     -- ^ object
                       -> String  -- ^ object property
                       -> IO ()
xfconfUnbindByProperty conf0 prop1 obj2 prop3 =
        withUTFString prop1 $ \prop1' ->
        withGObject obj2 $ \obj2' ->
        withUTFString prop3 $ \prop3' ->
        let conf0' = toXfconfChannel conf0
            f = {#call unsafe g_property_unbind_by_property #}
        in f conf0' prop1' obj2' prop3'

-- | Unbinds all Xfconf channel bindings (see 'xfconfBind')
-- to object. If object is an 'XfconfChannel', it will unbind all xfconf
-- properties on that channel. If object is a regular 'GObject' with
-- properties bound to a channel, all those bindings will be removed.
xfconfUnbindAll :: GObjectClass obj => obj -> IO ()
xfconfUnbindAll entity = withGObject entity unbind
  where unbind ptr = {#call unsafe g_property_unbind_all #} (castPtr ptr)

{----------------------------------------------------------------------
-- TODO

- xfconf-binding.h function list
-
- > bash $ sed '/^\(\/\| \*\|#\)/d' xfconf-binding.h | grep '('
-

DEMO    xfconf_g_property_bind
DONE    xfconf_g_property_bind_gdkcolor
DEMO    xfconf_g_property_unbind
DEMO    xfconf_g_property_unbind_all
DEMO    xfconf_g_property_unbind_by_property

----------------------------------------------------------------------}

-- vim:filetype=haskell: