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