module System.XFCE.Xfconf.Channel (
XfconfChannelClass,
XfconfChannel,
channelGet,
channelNew,
channelNewWithPropertyBase,
channelGetName,
channelName,
channelGetPropertyBase,
channelPropertyBase,
get,
onPropertyChanged,
afterPropertyChanged,
propertyChanged,
channelHasProperty,
channelIsPropertyLocked,
channelResetProperty,
channelGetKeys,
channelGetAllKeys,
channelGetStringWithDefault,
channelGetString,
channelSetString,
channelGetIntWithDefault,
channelGetInt,
channelSetInt,
channelGetUIntWithDefault,
channelGetUInt,
channelSetUInt,
channelGetUInt64WithDefault,
channelGetUInt64,
channelSetUInt64,
channelGetDoubleWithDefault,
channelGetDouble,
channelSetDouble,
channelGetBoolWithDefault,
channelGetBool,
channelSetBool,
channelGetUInt16WithDefault,
channelGetUInt16,
channelSetUInt16,
channelGetInt16WithDefault,
channelGetInt16,
channelSetInt16,
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
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
channelGet :: String
-> IO XfconfChannel
channelGet name = do
xfconfInit
ptr <- c_channel_get name'
obj <- FC.newForeignPtr ptr (xfconfFinalizer False ptr)
return $! XfconfChannel obj
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')
channelNew :: String
-> IO XfconfChannel
channelNew name = do
xfconfInit
objPtr <- c_channel_new name'
obj <- FC.newForeignPtr objPtr (xfconfFinalizer True objPtr)
return $! XfconfChannel obj
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')
channelNewWithPropertyBase :: String
-> String
-> 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
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')
withXfconf :: XfconfChannelClass self
=> self -> (Ptr XfconfChannel -> IO b) -> IO b
withXfconf self = let (XfconfChannel ptr) = toXfconfChannel self
in withForeignPtr ptr
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"
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)
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)
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')
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')
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')
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
channelGetAllKeys :: XfconfChannelClass self => self -> IO [String]
channelGetAllKeys chan = channelGetKeys chan "/"
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')
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')
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')
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')
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')
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')
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')
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')
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')
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')
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')
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')
foreign import ccall unsafe "xfconf.h xfconf_channel_get_property"
c_get_property :: Ptr XfconfChannel
-> Ptr CChar
-> Ptr GValue
-> IO CInt
foreign import ccall unsafe "xfconf.h xfconf_channel_set_property"
c_set_property :: Ptr XfconfChannel
-> Ptr CChar
-> Ptr GValue
-> IO CInt
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
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)
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
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)
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')
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')
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
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
valueInit gvalue bool
return Nothing
True -> Just `fmap` toXfconfValue gvalue
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"
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')
where marshallGHashTable ptr = if ptr == nullPtr
then return Nothing
else Just `fmap` mkGHashTable ptr
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
channelGetAllProperties :: XfconfChannelClass self => self
-> IO [(String, Maybe XfconfValue)]
channelGetAllProperties c = channelGetProperties c "/"
channelSetProperties :: (XfconfChannelClass self, XfconfValueClass a)
=> self -> [(String, Maybe a)] -> IO [Bool]
channelSetProperties chan = mapM (\(k,v) -> channelSetProperty chan k v)
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))))