{-# LANGUAGE ForeignFunctionInterface #-}

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

{- | A limited binding to glib GHashTable structures. We only handle
   hash tables as returned by @xfconf_channel_get_properties@. They have
   @gchar *@ keys and @GValue *@ values.

   Objectives:

        * get back the list of keys when keys are strings

        * extract values
-}




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

module System.XFCE.Xfconf.GHashTable (
        -- * Private data type
        GHashTable,
        -- * Marshalling functions
        withGHashTable,
        mkGHashTable,
        -- * Query functions
        gHashTableKeys,
        gHashTableLookup
        ) where

import Control.Monad ((>=>))

import System.Glib.GList
import System.Glib.GValue
import System.Glib.UTFString

import System.XFCE.Xfconf.FFI

-- | Haskell representation of a C @GHashTable*@ with @gchar *@ keys and
-- @GValue*@ values. Memory management is automatically managed by a
-- special Haskell finalizer calling @g_hash_table_destroy@.
newtype GHashTable = GHashTable (ForeignPtr (GHashTable))
{-# LINE 42 "./System/XFCE/Xfconf/GHashTable.chs" #-}
-- withGHashTable is auto-generated by C2HS, but not by gtk2hsC2hs
withGHashTable :: GHashTable -> (Ptr GHashTable -> IO b) -> IO b
withGHashTable (GHashTable ptr) = withForeignPtr ptr

-- | The glib finalizer for hash tables.
foreign import ccall unsafe "glib.h &g_hash_table_destroy"
        c_destroy :: FinalizerPtr GHashTable

{- | Marshal out a raw C @GHashTable*@ by wrapping it in the Haskell
   type 'GHashTable' and adding it a finalizer (which calls
   @g_hash_table_destroy@).

   Should be called for every function returning a @GHashTable*@, see
   for example in /System.XFCE.Xfconf.Channel.chs/:

  @
        {#fun unsafe get_properties as ^
                { channelPtr \`Channel\' -- ^ channel pointer
                , withUTFString* \`String\'  -- ^ property base
                } -> \`GHashTable\' mkGHashTable* #}
  @
-}
mkGHashTable :: Ptr GHashTable -> IO (GHashTable)
mkGHashTable ptr = GHashTable `fmap` newForeignPtr c_destroy ptr

-- XXX: fromGList calls g_list_delete_link which I suppose is the same
-- as calling g_list_free
-- XXX: readGList read whereas fromGList read *and* free the list
-- peekUTFString read whereas readUTFString read *and* free the str
-- somewhat, I feel completely lost (^^)
-- XXX: we do NOT readUTFString, we just peek them !
-- the GHashTablePtr finalizer should take care itself of freeing
-- them
-- | Retrieves every key inside a 'GHashTable'. The returned data is
-- valid until the table is modified.
gHashTableKeys :: GHashTable -> IO ([String])
gHashTableKeys a1 =
  withGHashTable a1 $ \a1' -> 
  gHashTableKeys'_ a1' >>= \res ->
  marshallOut res >>= \res' ->
  return (res')
{-# LINE 80 "./System/XFCE/Xfconf/GHashTable.chs" #-}
  where marshallOut = fromGList >=> mapM peekUTFString

-- | Looks up a key in a GHashTable. Note that this function cannot
-- distinguish between a key that is not present and one which is
-- present and has the value 'Nothing'.
gHashTableLookup :: GHashTable -> String -> IO (Maybe GValue)
gHashTableLookup a1 a2 =
  withGHashTable a1 $ \a1' -> 
  withUTFString' a2 $ \a2' -> 
  gHashTableLookup'_ a1' a2' >>= \res ->
  let {res' = marshallGValue res} in
  return (res')
{-# LINE 89 "./System/XFCE/Xfconf/GHashTable.chs" #-}

  where withUTFString' :: String -> (Ptr () -> IO b) -> IO b
        withUTFString' s io = withUTFString s (io . castPtr)

        marshallGValue :: Ptr a -> Maybe GValue
        marshallGValue ptr = if ptr == nullPtr
                                then Nothing
                                else Just . GValue . castPtr $ ptr

foreign import ccall unsafe "g_hash_table_get_keys"
  gHashTableKeys'_ :: ((Ptr GHashTable) -> (IO (Ptr ())))

foreign import ccall unsafe "g_hash_table_lookup"
  gHashTableLookup'_ :: ((Ptr GHashTable) -> ((Ptr ()) -> (IO (Ptr ()))))