packages feed

xfconf-4.8.0.0: System/XFCE/Xfconf/Channel.chs

{-# LANGUAGE CPP, ForeignFunctionInterface #-}
-- -*-haskell-*-
--
-- XXX: Property names are considered to be encoded in UTF-8 too
-- (string values are already encoded to / decoded from UTF-8).


{- | An application-defined domain for storing configuration settings.

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


#include <xfconf/xfconf.h>

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

module System.XFCE.Xfconf.Channel (
                -- * Detail
                -- $detail

                -- * Example
                -- $example

                -- * Class Hierarchy
                -- $classHierarchy

                -- * Channel Type
                -- re-exported from "System.XFCE.Xfconf.Types"
                XfconfChannelClass,
                XfconfChannel,

                -- * Constructors
                channelGet,
                channelNew,
                channelNewWithPropertyBase,

                -- * Attributes
                -- | The name of the channel.
                channelGetName,
                channelName,
                -- | Base property path.
                channelGetPropertyBase,
                channelPropertyBase,
                -- | re-exported from "System.Glib.Attributes"
                get,

                -- * Signals
                onPropertyChanged,
                afterPropertyChanged,
                propertyChanged,

                -- * Methods
                -- ** Misc
                channelHasProperty,
                channelIsPropertyLocked,
                channelResetProperty,
                channelGetKeys,
                channelGetAllKeys,

                -- ** Basic values get/set
                -- $basicValues
                channelGetStringWithDefault,
                channelGetString,
                channelSetString,
                channelGetIntWithDefault,
                channelGetInt,
                channelSetInt,
                channelGetUIntWithDefault,
                channelGetUInt,
                channelSetUInt,
                channelGetUInt64WithDefault,
                channelGetUInt64,
                channelSetUInt64,
                channelGetDoubleWithDefault,
                channelGetDouble,
                channelSetDouble,
                channelGetBoolWithDefault,
                channelGetBool,
                channelSetBool,

                -- ** Special Xfconf value
                -- $special16bits
                channelGetUInt16WithDefault,
                channelGetUInt16,
                channelSetUInt16,
                channelGetInt16WithDefault,
                channelGetInt16,
                channelSetInt16,

                -- ** Complex values get/set
                -- $complexValues
                channelSetStringList,
                channelGetStringList,
                channelSetArray,
                channelGetArray,
                channelGetProperty,
                channelSetProperty,
                channelGetAllProperties,
                channelGetProperties,
                channelSetProperties

                ) where

import Control.Monad (when)
import Data.Char     (toLower)
import qualified Foreign.Concurrent as FC

import System.Glib.GValue
import System.Glib.Attributes     (ReadAttr, readAttr, get)
import System.Glib.Properties     (objectGetPropertyString)
import System.Glib.GTypeConstants (bool, invalid)
import System.Glib.UTFString

import System.XFCE.Xfconf.FFI
{#import System.XFCE.Xfconf.Types #}
{#import System.XFCE.Xfconf.Signals #}
{#import System.XFCE.Xfconf.Unsafe #}
{#import System.XFCE.Xfconf.Values #}
{#import System.XFCE.Xfconf.GHashTable #}

{----------------------------------------------------------------------
-- Documentation
----------------------------------------------------------------------}

-- $detail
-- An XfconfChannel is a representation of a restricted domain or
-- namespace that an application can define to store configuration
-- settings. This is to ensure that different applications do not store
-- configuration keys with the same names.

-- $example
-- Channel initialisation:
--
-- @
-- chan \<- channelGet \"demo\"
-- --
-- -- Clear channel
-- channelResetProperty chan \"\/\" True
-- --
-- channelSetInt        chan \"\/MyInt\"    42
-- channelSetString     chan \"\/MyString\" \"Hello world\"
-- channelSetStringList chan \"\/MyList\"   \[ \"haskell\", \"xfce\", \"xfconf\", \"gtk\" \]
-- channelSetProperty   chan \"\/MyArray\"  (Just \[1..5\] :: Maybe \[Int\])
-- @
--
-- Which we'll give us:
--
-- >>> channelGetAllKeys chan >>= mapM_ print
-- "/MyInt"
-- "/MyString"
-- "/MyList"
-- "/MyArray"
--
-- >>> channelGetAllProperties chan >>= mapM_ print
-- ("/MyInt",Just (XfconfInt 42))
-- ("/MyString",Just (XfconfString "Hello world"))
-- ("/MyList",Just (XfconfArray [XfconfString "haskell",XfconfString "xfce",XfconfString "xfconf",XfconfString "gtk"]))
-- ("/MyArray",Just (XfconfArray [XfconfInt 1,XfconfInt 2,XfconfInt 3,XfconfInt 4,XfconfInt 5]))

-- $classHierarchy
-- @
-- | 'GObject'
-- | +-----'XfconfChannel'
-- @

{----------------------------------------------------------------------
-- Types and constructors
----------------------------------------------------------------------}

foreign import ccall unsafe "g_object_unref"
    g_object_unref :: Ptr XfconfChannel -> IO ()

xfconfFinalizer :: Bool -> Ptr XfconfChannel -> IO ()
xfconfFinalizer unref ptr = do
    when unref (g_object_unref ptr)
    xfconfShutdown

-- | Either creates a new 'Channel', or fetches a singleton object for
-- channel_name. This function always returns a valid object; no
-- checking is done to see if the channel exists or has a valid name.
--
-- May throw a 'GError', see 'xfconfInit' for more information.
channelGet :: String  -- ^ channel name
           -> IO XfconfChannel
channelGet name = do
        xfconfInit
        ptr <- c_channel_get name'
        obj <- FC.newForeignPtr ptr (xfconfFinalizer False ptr)
        return $! XfconfChannel obj

  -- Xfconf backend does not like upper case characters.
  where name' = map toLower name

{#fun unsafe channel_get as c_channel_get
        { withUTFString* `String' -- ^ channel name
        } -> `Ptr XfconfChannel' id#}

-- | Creates a new channel using @name@ as the channel\'s identifier.
-- This function always returns a valid object; no checking is done to
-- see if the channel exists or has a valid name.
--
-- Note: use of this function is not recommended, in favor of
-- 'channelGet', which returns a singleton object and saves a little
-- memory. However, 'channelNew' can be useful in some cases where you
-- want to tie an 'XfconfChannel' \'s lifetime (and thus the lifetime of
-- connected signals and bound GObject properties) to the lifetime of
-- another object.
--
-- May throw a 'GError', see 'xfconfInit' for more information.
channelNew :: String  -- ^ channel @name@
           -> IO XfconfChannel
channelNew name = do
        xfconfInit
        objPtr <- c_channel_new name'
        obj <- FC.newForeignPtr objPtr (xfconfFinalizer True objPtr)
        return $! XfconfChannel obj

  -- Xfconf backend does not like upper case characters.
  where name' = map toLower name

{#fun unsafe channel_new as c_channel_new
        { withUTFString* `String' -- ^ channel name
        } -> `Ptr XfconfChannel' id#}

-- | Creates a new channel using @name@ as the channel's identifier,
-- restricting the accessible properties to be rooted at @property_base@.
-- This function always returns a valid object; no checking is done to
-- see if the channel exists or has a valid name.
--
-- May throw a 'GError', see 'xfconfInit' for more information.
channelNewWithPropertyBase :: String  -- ^ channel @name@
                           -> String  -- ^ root @property_base@
                           -> IO XfconfChannel
channelNewWithPropertyBase name prop = do
        xfconfInit
        objPtr <- c_channel_new_with_property_base name' prop
        obj <- FC.newForeignPtr objPtr (xfconfFinalizer True objPtr)
        return $! XfconfChannel obj

  -- Xfconf backend does not like upper case characters.
  where name' = map toLower name

{#fun unsafe channel_new_with_property_base as c_channel_new_with_property_base
        { withUTFString* `String' -- ^ channel name
        , withUTFString* `String' -- ^ property base
        } -> `Ptr XfconfChannel' id#}

{----------------------------------------------------------------------
-- Utilities
----------------------------------------------------------------------}

withXfconf :: XfconfChannelClass self
           => self -> (Ptr XfconfChannel -> IO b) -> IO b
withXfconf self = let (XfconfChannel ptr) = toXfconfChannel self
                  in withForeignPtr ptr

{----------------------------------------------------------------------
-- Attributes
----------------------------------------------------------------------}

channelName :: XfconfChannelClass self => ReadAttr self String
channelName = readAttr channelGetName

channelGetName :: XfconfChannelClass self => self -> IO String
channelGetName = objectGetPropertyString "channel-name"

channelPropertyBase :: XfconfChannelClass self => ReadAttr self String
channelPropertyBase = readAttr channelGetPropertyBase

channelGetPropertyBase :: XfconfChannelClass self => self -> IO String
channelGetPropertyBase = objectGetPropertyString "property-base"

{----------------------------------------------------------------------
-- Signals
----------------------------------------------------------------------}

-- | Emitted whenever a property on channel has changed. If the change
-- was caused by the removal of property, value will be unset; you will
-- receive 'Nothing' instead of ('Just' 'XfconfValue').
--
propertyChanged :: XfconfChannelClass self
                => Signal self (String -> Maybe XfconfValue -> IO ())
propertyChanged = Signal (connector "property-changed")
  where connector name isAfter obj =
          connect_STRING_PTR__NONE name isAfter obj . convertHandler

onPropertyChanged :: XfconfChannelClass self
                  => self
                  -> (String -> Maybe XfconfValue -> IO ())
                  -> IO (ConnectId self)
onPropertyChanged gc handler =
  connect_STRING_PTR__NONE "property-changed" False gc
        (convertHandler handler)

afterPropertyChanged :: XfconfChannelClass self
                     => self
                     -> (String -> Maybe XfconfValue -> IO ())
                     -> IO (ConnectId self)
afterPropertyChanged gc handler =
  connect_STRING_PTR__NONE "property-changed" True gc
        (convertHandler handler)

-- C handler is "Obj -> CString -> Ptr () -> Ptr () -> IO ()"

-- haskell "pre-marshalled" handler is
--    "String -> Ptr () -> IO ()"

-- we want to pass a "String -> Maybe XfconfValue -> IO ()" instead

-- ... hence we convert Ptr GValue to Maybe XfconfValue
convertHandler :: (String -> Maybe XfconfValue -> IO ())
               -> (String -> Ptr () -> IO ())
convertHandler handler = \key ptr1 -> do
  let gvalue = GValue (castPtr ptr1)
  gtype <- valueGetType gvalue
  if gtype == invalid
     then handler key Nothing
     else do xvalue <- toXfconfValue gvalue
             handler key (Just xvalue)

{----------------------------------------------------------------------
-- Methods: misc
----------------------------------------------------------------------}

-- | Checks to see if property exists on channel.
{#fun unsafe channel_has_property as ^
        `XfconfChannelClass self' =>
        { withXfconf*    `self'   -- ^ channel
        , withUTFString* `String' -- ^ property
        } -> `Bool' toBool #}

-- | Queries whether or not property on channel is locked by system
-- policy. If the property is locked, calls to 'setProperty' (or any of
-- the \"set\" family of functions) or 'resetProperty' will fail.
{#fun unsafe channel_is_property_locked as ^
        `XfconfChannelClass self' =>
        { withXfconf*    `self'    -- ^ channel
        , withUTFString* `String'  -- ^ property
        } -> `Bool' toBool #}

-- | Resets properties starting at (and including) the 'String'
-- property_base. If recursive is @True@, will also reset all properties
-- that are under property_base in the property hierarchy.
--
-- A bit of an explanation as to what this function actually does: Since
-- Xfconf backends are expected to support setting defaults via what you
-- might call \"optional schema,\" you can't really \"remove\"
-- properties.  Since the client library can't know if a channel
-- provides default values (or even if the backend supports it!), at
-- best it can only reset properties to their default values. To
-- retrieve all properties in the channel, specify \"/\".
{#fun unsafe channel_reset_property as ^
        `XfconfChannelClass self' =>
        { withXfconf*    `self'    -- ^ channel
        , withUTFString* `String'  -- ^ property base
        , fromBool       `Bool'    -- ^ recursive
        } -> `()' id#}

-- | Retrieves the list of properties from 'Channel'. The value of the
-- property specified by the 'String' property_base and all
-- sub-properties are retrieved. To retrieve all properties in the
-- channel, specify \"/\".
channelGetKeys :: XfconfChannelClass self => self -> String -> IO [String]
channelGetKeys chan prop = do
        maybeGHT <- c_get_properties chan prop
        case maybeGHT of
             Nothing  -> return []
             Just ght -> gHashTableKeys ght

-- | Alias to @channelGetKeys channel \"/\"@
channelGetAllKeys :: XfconfChannelClass self => self -> IO [String]
channelGetAllKeys chan = channelGetKeys chan "/"

{----------------------------------------------------------------------
-- Basic values set/get aka the boring stuff

-- The following functions are a relic of my first FFI, hsc2hs and c2hs
-- experimentation. All the get/set-ters could probably be based on
-- the unique channelGetProperty function.
--
-- ... and I should probably provide a fromXfconfValue function to ease
-- this operation ...
----------------------------------------------------------------------}

-- $basicValues
-- The following functions are simple getters\/setters for dead simple
-- glib type (gint, gboolean, gchar*, ...). Set functions come in two
-- flavors:
--
--  * @getTypeWidthDefault@ takes a third parameter which is the default
--    fallback value returned by xfconf if no value was found
--
--  * @getType@ are convenience function which returned hard-coded
--    default values. (0 for (u)ints, floats and doubles, \"\" for
--    strings, False for booleans, etc. )
--
-- Note that if you wish to \"unset\" a value, you should probably use
-- 'channelResetProperty'.

--- INT
{#fun unsafe channel_get_int as channelGetIntWithDefault
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , fromIntegral    `Int32'   -- ^ fallback value
        } -> `Int32' fromIntegral #}

channelGetInt :: XfconfChannelClass self => self -> String -> IO Int32
channelGetInt chan prop = channelGetIntWithDefault chan prop 0

{#fun unsafe channel_set_int as ^
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , fromIntegral    `Int32'   -- ^ new value
        } -> `Bool' toBool #}

--- UINT
{#fun unsafe channel_get_uint as channelGetUIntWithDefault
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , fromIntegral    `Word32'  -- ^ fallback value
        } ->  `Word32' fromIntegral #}

channelGetUInt :: XfconfChannelClass self => self -> String -> IO Word32
channelGetUInt chan prop = channelGetUIntWithDefault chan prop 0

{#fun unsafe channel_set_uint as channelSetUInt
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , fromIntegral    `Word32'  -- ^ new value
        } -> `Bool' toBool #}

--- UINT64
{#fun unsafe channel_get_uint64 as channelGetUInt64WithDefault
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , fromIntegral    `Word64'  -- ^ fallback value
        } -> `Word64' fromIntegral #}

channelGetUInt64 :: XfconfChannelClass self => self -> String -> IO Word64
channelGetUInt64 chan prop = channelGetUInt64WithDefault chan prop 0

{#fun unsafe channel_set_uint64 as channelSetUInt64
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , fromIntegral    `Word64'  -- ^ new value
        } -> `Bool' toBool #}

--- Boolean
{#fun unsafe channel_get_bool as channelGetBoolWithDefault
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , fromBool        `Bool'    -- ^ fallback value
        } -> `Bool' toBool #}

channelGetBool :: XfconfChannelClass self => self -> String -> IO Bool
channelGetBool chan prop = channelGetBoolWithDefault chan prop False

{#fun unsafe channel_set_bool as ^
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , fromBool        `Bool'    -- ^ new value
        } -> `Bool' toBool #}

--- Double
{#fun unsafe channel_get_double as channelGetDoubleWithDefault
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , realToFrac      `Double'  -- ^ fallback value
        } -> `Double' realToFrac #}

channelGetDouble :: XfconfChannelClass self => self -> String -> IO Double
channelGetDouble chan prop = channelGetDoubleWithDefault chan prop 0.0

{#fun unsafe channel_set_double as ^
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , realToFrac      `Double'  -- ^ new value
        } -> `Bool' toBool #}

--- String
{#fun unsafe channel_get_string as channelGetStringWithDefault
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , withUTFString*  `String'  -- ^ fallback value
        } ->  `String' readUTFString* #}

channelGetString :: XfconfChannelClass self => self -> String -> IO String
channelGetString channel prop = channelGetStringWithDefault channel prop "N/A"

{#fun unsafe channel_set_string as ^
        `XfconfChannelClass self' =>
        { withXfconf*     `self'    -- ^ channel pointer
        , withUTFString*  `String'  -- ^ property
        , withUTFString*  `String'  -- ^ new value
        } -> `Bool' toBool #}

{----------------------------------------------------------------------
-- gint16 and guint16
----------------------------------------------------------------------}

-- $special16bits
-- The same remark as for the previous \"basic values\" applies.

-- common infrastructure, since xfconf doesn't have raw get/set for
-- uint16 and int16, we will use channel_get/set_property with GValues
foreign import ccall unsafe "xfconf.h xfconf_channel_get_property"
        c_get_property :: Ptr XfconfChannel -- ^ channel pointer
                       -> Ptr CChar         -- ^ property
                       -> Ptr GValue        -- ^ gvalue*
                       -> IO CInt           -- ^ success

foreign import ccall unsafe "xfconf.h xfconf_channel_set_property"
        c_set_property :: Ptr XfconfChannel -- ^ channel pointer
                       -> Ptr CChar         -- ^ property
                       -> Ptr GValue        -- ^ gvalue*
                       -> IO CInt           -- ^ success

--- UINT16
channelGetUInt16WithDefault :: XfconfChannelClass self
                            => self -> String -> Word16 -> IO Word16
channelGetUInt16WithDefault chan property i =
        withXfconf chan $ \chanPtr ->
        withUTFString property $ \prop ->
        allocaGValue $ \(GValue gPtr) -> do
        r <- c_get_property chanPtr prop gPtr
        case toBool r of
             False -> return i
             -- FIXME: Integer store as uint16 are retrieved as UInt.
             -- This is a bug present in the C version of the library.
             -- Not the present FFI binding fault.
             True  -> do { v <- toXfconfValue (GValue gPtr)
                         ; case v of
                         ;   XfconfUInt16 x -> return x
                         ;   XfconfUInt x -> return (fromIntegral x)
                         ;   _ -> error "Cannot decode gPtr UInt16" }

channelGetUInt16 :: XfconfChannelClass self
                 => self -> String -> IO Word16
channelGetUInt16 chan prop = channelGetUInt16WithDefault chan prop 0

channelSetUInt16 :: XfconfChannelClass self
                 => self -> String -> Word16 -> IO Bool
channelSetUInt16 chan property i =
        withXfconf chan $ \chanPtr ->
        withUTFString property $ \prop ->
        allocaGValue $ \gvalue@(GValue gPtr) -> do
        valueInit gvalue uint16
        valueSetUInt16 gvalue (fromIntegral i)
        r <- c_set_property chanPtr prop gPtr
        return (toBool r)

--- INT16
channelGetInt16WithDefault :: XfconfChannelClass self
                           => self -> String -> Int16 -> IO Int16
channelGetInt16WithDefault chan property i =
        withXfconf chan $ \chanPtr ->
        withUTFString property $ \prop ->
        allocaGValue $ \gvalue@(GValue gPtr) -> do
        r <- c_get_property chanPtr prop gPtr
        case toBool r of
             False -> return i
             -- FIXME: Same \"bug\" as before, xfconfd return Int16 as
             -- simple Int. So we cheat a little in Haskell to keep
             -- things coherent.
             True  -> do { v <- toXfconfValue gvalue
                         ; case v of
                         ;   XfconfInt16 x -> return x
                         ;   XfconfInt x -> return (fromIntegral x)
                         ;   _ -> error "Cannot decode gPtr Int16" }

channelGetInt16 :: XfconfChannelClass self
                => self -> String -> IO Int16
channelGetInt16 chan prop = channelGetInt16WithDefault chan prop 0

channelSetInt16 :: XfconfChannelClass self
                => self -> String -> Int16 -> IO Bool
channelSetInt16 chan property i =
        withXfconf chan $ \chanPtr ->
        withUTFString property $ \prop ->
        allocaGValue $ \gvalue@(GValue gPtr) -> do
        valueInit gvalue int16
        valueSetInt16 gvalue (fromIntegral i)
        r <- c_set_property chanPtr prop gPtr
        return (toBool r)

{----------------------------------------------------------------------
-- Complex values set/get aka the f***ing stuff
----------------------------------------------------------------------}

-- $complexValues
-- C Arrays, structures and named structures are not implemented.
-- (correction: you can now retrieve and store arrays, just do not play
-- with complex arrays -- eg. no array of arrays -- and be careful of
-- the difference betwwen 'channelSetStringList', 'channelGetArray' or
-- 'channelGetProperty').

--- String List
{#fun unsafe channel_get_string_list as ^
        `XfconfChannelClass self' =>
        { withXfconf*          `self'    -- ^ channel pointer
        , withUTFString*       `String'  -- ^ property
        } -> `[String]' readUTFStrings* #}

  where readUTFStrings ptr = if ptr == nullPtr
                                then return []
                                else readUTFStringArray0 ptr

{#fun unsafe channel_set_string_list as c_set_string_list
        `XfconfChannelClass self' =>
        { withXfconf*          `self'     -- ^ channel pointer
        , withUTFString*       `String'   -- ^ property
        , withUTFStringArray0* `[String]' -- ^ new value
        } -> `Bool' toBool #}

-- | Handles [] empty string lists by resetting the value with
-- 'channelResetProperty'
channelSetStringList :: XfconfChannelClass self
                     => self -> String -> [String] -> IO Bool
channelSetStringList ch prop [] = channelResetProperty ch prop False >> return True
channelSetStringList ch prop xs = c_set_string_list ch prop xs

channelGetArray :: XfconfChannelClass self
                => self -> String -> IO [XfconfValue]
channelGetArray channel property = do
        result <- channelGetProperty channel property
        case result of
             Just (XfconfArray xs) -> return xs
             Nothing               -> return []
             _                     -> error "not a XfconfArray"

channelSetArray :: (XfconfChannelClass self, XfconfValueClass a)
                => self -> String -> [a] -> IO Bool
channelSetArray channel property xs =
        withXfconf channel $ \conf ->
        withUTFString property $ \prop ->
        mapM toXfconfValue xs >>= \values ->
        allocaGValueArray values $ \(GValue gptr) ->
        c_set_property conf prop gptr >>= return . toBool


-- | Generic function for retrieving 'XfconfValue's. As for
-- 'channelGetProperties', only work with the limited set of simple
-- types supported by "System.XFCE.Xfconf.Values".
channelGetProperty :: XfconfChannelClass self
                   => self -> String -> IO (Maybe XfconfValue)
channelGetProperty chan property =
        withXfconf chan $ \chanPtr ->
        withUTFString property $ \prop ->
        allocaGValue $ \gvalue@(GValue gPtr) -> do
        success <- c_get_property chanPtr prop gPtr
        case toBool success of
          False -> do -- gvalue was not initialize by c_get_property
                      -- allocaGValue will try to unset it
                      -- and throw an error if our gvalue stay as it is
                      valueInit gvalue bool
                      return Nothing
          True  -> Just `fmap` toXfconfValue gvalue

-- | Generic function for storing 'XfconfValue's. As for
-- 'channelGetProperties', only work with the limited set of simple
-- types supported by "System.XFCE.Xfconf.Values".
--
-- Reset property and return True if @Maybe XfconfValue@ is 'Nothing' or
-- throw an error if the value is an instance of @Just
-- ('XfconfNotImplemented' t)@.
channelSetProperty :: (XfconfChannelClass self, XfconfValueClass a)
                   => self -> String -> Maybe a -> IO Bool

channelSetProperty ch p Nothing  = do
        channelResetProperty ch p False
        return True

channelSetProperty ch p (Just v) = do
        value <- toXfconfValue v
        case value of
                XfconfInt        i -> channelSetInt        ch p i
                XfconfUInt       i -> channelSetUInt       ch p i
                XfconfUInt64     i -> channelSetUInt64     ch p i
                XfconfDouble     d -> channelSetDouble     ch p d
                XfconfBool       b -> channelSetBool       ch p b
                XfconfString     s -> channelSetString     ch p s
                XfconfInt16      i -> channelSetInt16      ch p i
                XfconfUInt16     i -> channelSetUInt16     ch p i
                XfconfStringList l -> channelSetStringList ch p l
                XfconfArray      a -> channelSetArray      ch p a
                _                  -> error "unknown XfconfValue type"

-- | Retrieves multiple properties from 'Channel' and stores them in a
-- 'GHashTable' in which the keys correspond to the string property
-- names, and the values correspond to variant 'GValue' values. The
-- value of the property specified by the 'String' property_base and all
-- sub-properties are retrieved. To retrieve all properties in the
-- channel, specify \"/\".
{#fun unsafe channel_get_properties as c_get_properties
        `XfconfChannelClass self' =>
        { withXfconf*    `self'    -- ^ channel
        , withUTFString* `String'  -- ^ property base
        } -> `Maybe GHashTable' marshallGHashTable* #}

  where marshallGHashTable ptr = if ptr == nullPtr
                                    then return Nothing
                                    else Just `fmap` mkGHashTable ptr

-- | A convenience function returning an association list [(key,
-- value)]. Work only for the data types defined in
-- "System.XFCE.Xfconf.Values" (i.e. no (named) structures).
-- See also the limitation imposed by 'gHashTableLookup'. The value of
-- the property specified by the 'String' property_base and all
-- sub-properties are retrieved. To retrieve all properties in the
-- channel, specify \"/\".
channelGetProperties :: XfconfChannelClass self
                     => self -> String -> IO [(String, Maybe XfconfValue)]
channelGetProperties chan prop = do
        maybeGHT <- c_get_properties chan prop
        case maybeGHT of
             Nothing  -> return []
             Just ght -> do keys <- gHashTableKeys ght
                            values <- mapM (gLookup ght) keys
                            return (zip keys values)

  where gLookup :: GHashTable -> String -> IO (Maybe XfconfValue)
        gLookup ght key = do value <- gHashTableLookup ght key
                             case value of
                                 Nothing -> return Nothing
                                 Just x -> Just `fmap` toXfconfValue x

-- | Alias to @channelGetProperties channel \"/\"@
channelGetAllProperties :: XfconfChannelClass self => self
                        -> IO [(String, Maybe XfconfValue)]
channelGetAllProperties c = channelGetProperties c "/"

-- | A convenience function equivalent to
-- @
--    mapM (\(k,v) -> channelSetProperty channel k v) properties
-- @
channelSetProperties :: (XfconfChannelClass self, XfconfValueClass a)
                     => self -> [(String, Maybe a)] -> IO [Bool]
channelSetProperties chan = mapM (\(k,v) -> channelSetProperty chan k v)

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

- xfconf-channel.h function list
-
- > bash $ sed '/^\(\/\| \*\|#\)/d' xfconf-channel.h | grep '('
-
DONE    xfconf_channel_get_type
TESTED  xfconf_channel_get
TESTED  xfconf_channel_new
TESTED  xfconf_channel_new_with_property_base
TESTED  xfconf_channel_has_property
TESTED  xfconf_channel_is_property_locked
TESTED  xfconf_channel_reset_property
TESTED  xfconf_channel_get_properties
TESTED  xfconf_channel_get_string
TESTED  xfconf_channel_set_string
TESTED  xfconf_channel_get_int
TESTED  xfconf_channel_set_int
TESTED  xfconf_channel_get_uint
TESTED  xfconf_channel_set_uint
TESTED  xfconf_channel_get_uint64
TESTED  xfconf_channel_set_uint64
TESTED  xfconf_channel_get_double
TESTED  xfconf_channel_set_double
TESTED  xfconf_channel_get_bool
TESTED  xfconf_channel_set_bool
TESTED  xfconf_channel_get_string_list
TESTED  xfconf_channel_set_string_list
PARTIAL xfconf_channel_get_property
PARTIAL xfconf_channel_set_property
SOMEHOW xfconf_channel_get_array
        xfconf_channel_get_array_valist
        xfconf_channel_get_arrayv
SOMEHOW xfconf_channel_set_array
        xfconf_channel_set_array_valist
        xfconf_channel_set_arrayv
        xfconf_channel_get_named_struct
        xfconf_channel_set_named_struct
        xfconf_channel_get_struct
        xfconf_channel_get_struct_valist
        xfconf_channel_get_structv
        xfconf_channel_set_struct
        xfconf_channel_set_struct_valist
        xfconf_channel_set_structv

- xfconf-channel.h attributes list
TESTED  channel-name
TESTED  property-base

- xfconf-channel.h signals list
TESTED  property-changed

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

-- vim:filetype=haskell: