{-# LANGUAGE ForeignFunctionInterface #-}

{-# LINE 2 "./System/XFCE/Xfconf/Core.chs" #-}
-- vim:filetype=haskell:
--

-- XXX: Should we consider property names to be encoded in UTF-8 too
-- (string values are already encoded to / decoded from UTF-8).

{- | Core functionalities for libxfconf.

   There is actually only one core function : 'xfconfListChannels'.
   Access to the C functions xfconf_init() and xfconf_shutdown() are
   available in the "System.XFCE.Xfconf.Unsafe" module and should, in
   most cases, not be used in Haskell.

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





{-# LINE 23 "./System/XFCE/Xfconf/Core.chs" #-}

module System.XFCE.Xfconf.Core (
                xfconfListChannels,
                ) where

import Control.Exception (bracket_)

import System.Glib.UTFString

import System.XFCE.Xfconf.FFI
import System.XFCE.Xfconf.Unsafe
{-# LINE 34 "./System/XFCE/Xfconf/Core.chs" #-}

{----------------------------------------------------------------------
-- Core
----------------------------------------------------------------------}

-- | List the names of available channels.
xfconfListChannels :: IO [String]
xfconfListChannels = bracket_ xfconfInit xfconfShutdown $
        xfconf_list_channels >>= readUTFStringArray0

-- TODO: implement xfconf_named_struct_register

foreign import ccall unsafe "xfconf_list_channels"
  xfconf_list_channels :: (IO (Ptr (Ptr CChar)))