{-# LANGUAGE ForeignFunctionInterface #-}

{-# LINE 2 "./System/XFCE/Xfconf/Channel.chs" #-}
-- -*-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
-}





{-# LINE 18 "./System/XFCE/Xfconf/Channel.chs" #-}

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
{-# LINE 118 "./System/XFCE/Xfconf/Channel.chs" #-}
import System.XFCE.Xfconf.Signals
{-# LINE 119 "./System/XFCE/Xfconf/Channel.chs" #-}
import System.XFCE.Xfconf.Unsafe
{-# LINE 120 "./System/XFCE/Xfconf/Channel.chs" #-}
import System.XFCE.Xfconf.Values
{-# LINE 121 "./System/XFCE/Xfconf/Channel.chs" #-}
import System.XFCE.Xfconf.GHashTable
{-# LINE 122 "./System/XFCE/Xfconf/Channel.chs" #-}

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

c_channel_get :: String -> IO (Ptr XfconfChannel)
c_channel_get a1 =
  withUTFString a1 $ \a1' -> 
  c_channel_get'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 199 "./System/XFCE/Xfconf/Channel.chs" #-}

-- | 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

c_channel_new :: String -> IO (Ptr XfconfChannel)
c_channel_new a1 =
  withUTFString a1 $ \a1' -> 
  c_channel_new'_ a1' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 226 "./System/XFCE/Xfconf/Channel.chs" #-}

-- | 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

c_channel_new_with_property_base :: String -> String -> IO (Ptr XfconfChannel)
c_channel_new_with_property_base a1 a2 =
  withUTFString a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  c_channel_new_with_property_base'_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 249 "./System/XFCE/Xfconf/Channel.chs" #-}

{----------------------------------------------------------------------
-- 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.
channelHasProperty :: XfconfChannelClass self => self -> String -> IO (Bool)
channelHasProperty a1 a2 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  channelHasProperty'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 333 "./System/XFCE/Xfconf/Channel.chs" #-}

-- | 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.
channelIsPropertyLocked :: XfconfChannelClass self => self -> String -> IO (Bool)
channelIsPropertyLocked a1 a2 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  channelIsPropertyLocked'_ a1' a2' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 342 "./System/XFCE/Xfconf/Channel.chs" #-}

-- | 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 \"/\".
channelResetProperty :: XfconfChannelClass self => self -> String -> Bool -> IO (())
channelResetProperty a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromBool a3} in 
  channelResetProperty'_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')
{-# LINE 360 "./System/XFCE/Xfconf/Channel.chs" #-}

-- | 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
channelGetIntWithDefault :: XfconfChannelClass self => self -> String -> Int32 -> IO (Int32)
channelGetIntWithDefault a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  channelGetIntWithDefault'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')
{-# LINE 409 "./System/XFCE/Xfconf/Channel.chs" #-}

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

channelSetInt :: XfconfChannelClass self => self -> String -> Int32 -> IO (Bool)
channelSetInt a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  channelSetInt'_ a1' a2' a3' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 419 "./System/XFCE/Xfconf/Channel.chs" #-}

--- UINT
channelGetUIntWithDefault :: XfconfChannelClass self => self -> String -> Word32 -> IO (Word32)
channelGetUIntWithDefault a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  channelGetUIntWithDefault'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')
{-# LINE 427 "./System/XFCE/Xfconf/Channel.chs" #-}

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

channelSetUInt :: XfconfChannelClass self => self -> String -> Word32 -> IO (Bool)
channelSetUInt a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  channelSetUInt'_ a1' a2' a3' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 437 "./System/XFCE/Xfconf/Channel.chs" #-}

--- UINT64
channelGetUInt64WithDefault :: XfconfChannelClass self => self -> String -> Word64 -> IO (Word64)
channelGetUInt64WithDefault a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  channelGetUInt64WithDefault'_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')
{-# LINE 445 "./System/XFCE/Xfconf/Channel.chs" #-}

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

channelSetUInt64 :: XfconfChannelClass self => self -> String -> Word64 -> IO (Bool)
channelSetUInt64 a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromIntegral a3} in 
  channelSetUInt64'_ a1' a2' a3' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 455 "./System/XFCE/Xfconf/Channel.chs" #-}

--- Boolean
channelGetBoolWithDefault :: XfconfChannelClass self => self -> String -> Bool -> IO (Bool)
channelGetBoolWithDefault a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromBool a3} in 
  channelGetBoolWithDefault'_ a1' a2' a3' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 463 "./System/XFCE/Xfconf/Channel.chs" #-}

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

channelSetBool :: XfconfChannelClass self => self -> String -> Bool -> IO (Bool)
channelSetBool a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = fromBool a3} in 
  channelSetBool'_ a1' a2' a3' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 473 "./System/XFCE/Xfconf/Channel.chs" #-}

--- Double
channelGetDoubleWithDefault :: XfconfChannelClass self => self -> String -> Double -> IO (Double)
channelGetDoubleWithDefault a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = realToFrac a3} in 
  channelGetDoubleWithDefault'_ a1' a2' a3' >>= \res ->
  let {res' = realToFrac res} in
  return (res')
{-# LINE 481 "./System/XFCE/Xfconf/Channel.chs" #-}

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

channelSetDouble :: XfconfChannelClass self => self -> String -> Double -> IO (Bool)
channelSetDouble a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  let {a3' = realToFrac a3} in 
  channelSetDouble'_ a1' a2' a3' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 491 "./System/XFCE/Xfconf/Channel.chs" #-}

--- String
channelGetStringWithDefault :: XfconfChannelClass self => self -> String -> String -> IO (String)
channelGetStringWithDefault a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  withUTFString a3 $ \a3' -> 
  channelGetStringWithDefault'_ a1' a2' a3' >>= \res ->
  readUTFString res >>= \res' ->
  return (res')
{-# LINE 499 "./System/XFCE/Xfconf/Channel.chs" #-}

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

channelSetString :: XfconfChannelClass self => self -> String -> String -> IO (Bool)
channelSetString a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  withUTFString a3 $ \a3' -> 
  channelSetString'_ a1' a2' a3' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 509 "./System/XFCE/Xfconf/Channel.chs" #-}

{----------------------------------------------------------------------
-- 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
channelGetStringList :: XfconfChannelClass self => self -> String -> IO ([String])
channelGetStringList a1 a2 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  channelGetStringList'_ a1' a2' >>= \res ->
  readUTFStrings res >>= \res' ->
  return (res')
{-# LINE 616 "./System/XFCE/Xfconf/Channel.chs" #-}

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

c_set_string_list :: XfconfChannelClass self => self -> String -> [String] -> IO (Bool)
c_set_string_list a1 a2 a3 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  withUTFStringArray0 a3 $ \a3' -> 
  c_set_string_list'_ a1' a2' a3' >>= \res ->
  let {res' = toBool res} in
  return (res')
{-# LINE 627 "./System/XFCE/Xfconf/Channel.chs" #-}

-- | 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 \"/\".
c_get_properties :: XfconfChannelClass self => self -> String -> IO (Maybe GHashTable)
c_get_properties a1 a2 =
  withXfconf a1 $ \a1' -> 
  withUTFString a2 $ \a2' -> 
  c_get_properties'_ a1' a2' >>= \res ->
  marshallGHashTable res >>= \res' ->
  return (res')
{-# LINE 712 "./System/XFCE/Xfconf/Channel.chs" #-}

  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:

foreign import ccall unsafe "xfconf_channel_get"
  c_channel_get'_ :: ((Ptr CChar) -> (IO (Ptr XfconfChannel)))

foreign import ccall unsafe "xfconf_channel_new"
  c_channel_new'_ :: ((Ptr CChar) -> (IO (Ptr XfconfChannel)))

foreign import ccall unsafe "xfconf_channel_new_with_property_base"
  c_channel_new_with_property_base'_ :: ((Ptr CChar) -> ((Ptr CChar) -> (IO (Ptr XfconfChannel))))

foreign import ccall unsafe "xfconf_channel_has_property"
  channelHasProperty'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall unsafe "xfconf_channel_is_property_locked"
  channelIsPropertyLocked'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (IO CInt)))

foreign import ccall unsafe "xfconf_channel_reset_property"
  channelResetProperty'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CInt -> (IO ()))))

foreign import ccall unsafe "xfconf_channel_get_int"
  channelGetIntWithDefault'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CInt -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_set_int"
  channelSetInt'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CInt -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_get_uint"
  channelGetUIntWithDefault'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CUInt -> (IO CUInt))))

foreign import ccall unsafe "xfconf_channel_set_uint"
  channelSetUInt'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CUInt -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_get_uint64"
  channelGetUInt64WithDefault'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CULong -> (IO CULong))))

foreign import ccall unsafe "xfconf_channel_set_uint64"
  channelSetUInt64'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CULong -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_get_bool"
  channelGetBoolWithDefault'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CInt -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_set_bool"
  channelSetBool'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CInt -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_get_double"
  channelGetDoubleWithDefault'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CDouble -> (IO CDouble))))

foreign import ccall unsafe "xfconf_channel_set_double"
  channelSetDouble'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (CDouble -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_get_string"
  channelGetStringWithDefault'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO (Ptr CChar)))))

foreign import ccall unsafe "xfconf_channel_set_string"
  channelSetString'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_get_string_list"
  channelGetStringList'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (IO (Ptr (Ptr CChar)))))

foreign import ccall unsafe "xfconf_channel_set_string_list"
  c_set_string_list'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> ((Ptr (Ptr CChar)) -> (IO CInt))))

foreign import ccall unsafe "xfconf_channel_get_properties"
  c_get_properties'_ :: ((Ptr XfconfChannel) -> ((Ptr CChar) -> (IO (Ptr GHashTable))))