-- GENERATED by C->Haskell Compiler, version 0.13.13 (gtk2hs branch) "Bin IO", 27 May 2012 (Haskell)
-- Edit the ORIGINAL .chs file instead!


{-# LINE 1 "./System/Glib/Properties.chs" #-}
-- -*-haskell-*-
--  GIMP Toolkit (GTK) GObject Properties
--
--  Author : Duncan Coutts
--
--  Created: 16 April 2005
--
--  Copyright (C) 2005 Duncan Coutts
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Lesser General Public
--  License as published by the Free Software Foundation; either
--  version 2.1 of the License, or (at your option) any later version.
--
--  This library is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
--  Lesser General Public License for more details.
--
-- |
-- Maintainer  : gtk2hs-users@lists.sourceforge.net
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Functions for getting and setting GObject properties
--
module System.Glib.Properties (
  -- * per-type functions for getting and setting GObject properties
  objectSetPropertyInt,
  objectGetPropertyInt,
  objectSetPropertyUInt,
  objectGetPropertyUInt,
  objectSetPropertyInt64,
  objectGetPropertyInt64,
  objectSetPropertyUInt64,
  objectGetPropertyUInt64,
  objectSetPropertyChar,
  objectGetPropertyChar,
  objectSetPropertyBool,
  objectGetPropertyBool,
  objectSetPropertyEnum,
  objectGetPropertyEnum,
  objectSetPropertyFlags,
  objectGetPropertyFlags,
  objectSetPropertyFloat,
  objectGetPropertyFloat,
  objectSetPropertyDouble,
  objectGetPropertyDouble,
  objectSetPropertyString,
  objectGetPropertyString,
  objectSetPropertyMaybeString,
  objectGetPropertyMaybeString,
  objectSetPropertyFilePath,
  objectGetPropertyFilePath,
  objectSetPropertyMaybeFilePath,
  objectGetPropertyMaybeFilePath,
  objectSetPropertyBoxedOpaque,
  objectGetPropertyBoxedOpaque,
  objectSetPropertyBoxedStorable,
  objectGetPropertyBoxedStorable,
  objectSetPropertyGObject,
  objectGetPropertyGObject,

  -- * constructors for attributes backed by GObject properties
  newAttrFromIntProperty,
  readAttrFromIntProperty,
  newAttrFromUIntProperty,
  readAttrFromUIntProperty,
  writeAttrFromUIntProperty,
  newAttrFromCharProperty,
  readAttrFromCharProperty,
  newAttrFromBoolProperty,
  readAttrFromBoolProperty,
  newAttrFromFloatProperty,
  readAttrFromFloatProperty,
  newAttrFromDoubleProperty,
  readAttrFromDoubleProperty,
  newAttrFromEnumProperty,
  readAttrFromEnumProperty,
  writeAttrFromEnumProperty,
  newAttrFromFlagsProperty,
  readAttrFromFlagsProperty,
  newAttrFromStringProperty,
  readAttrFromStringProperty,
  writeAttrFromStringProperty,
  newAttrFromMaybeStringProperty,
  readAttrFromMaybeStringProperty,
  writeAttrFromMaybeStringProperty,
  newAttrFromFilePathProperty,
  readAttrFromFilePathProperty,
  writeAttrFromFilePathProperty,
  newAttrFromMaybeFilePathProperty,
  readAttrFromMaybeFilePathProperty,
  writeAttrFromMaybeFilePathProperty,
  newAttrFromBoxedOpaqueProperty,
  readAttrFromBoxedOpaqueProperty,
  writeAttrFromBoxedOpaqueProperty,
  newAttrFromBoxedStorableProperty,
  readAttrFromBoxedStorableProperty,
  newAttrFromObjectProperty,
  readAttrFromObjectProperty,
  writeAttrFromObjectProperty,
  newAttrFromMaybeObjectProperty,
  readAttrFromMaybeObjectProperty,
  writeAttrFromMaybeObjectProperty,

  -- TODO: do not export these once we dump the old TreeList API:
  objectGetPropertyInternal,
  objectSetPropertyInternal,
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Flags        (Flags)
import System.Glib.Types
{-# LINE 117 "./System/Glib/Properties.chs" #-}
import System.Glib.GValue   (GValue(GValue), valueInit, allocaGValue)
import qualified System.Glib.GTypeConstants as GType
import System.Glib.GType
import System.Glib.GValueTypes
import System.Glib.Attributes   (Attr, ReadAttr, WriteAttr, ReadWriteAttr,
                                newNamedAttr, readNamedAttr, writeNamedAttr)


{-# LINE 125 "./System/Glib/Properties.chs" #-}

objectSetPropertyInternal :: GObjectClass gobj => GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal :: forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
gtype GValue -> a -> IO ()
valueSet String
prop gobj
obj a
val =
  String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
prop ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
propPtr ->
  (GValue -> IO ()) -> IO ()
forall b. (GValue -> IO b) -> IO b
allocaGValue ((GValue -> IO ()) -> IO ()) -> (GValue -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \GValue
gvalue -> do
  GValue -> GType -> IO ()
valueInit GValue
gvalue GType
gtype
  GValue -> a -> IO ()
valueSet GValue
gvalue a
val
  (\(GObject ForeignPtr GObject
arg1) CString
arg2 (GValue Ptr GValue
arg3) -> ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GObject
arg1 ((Ptr GObject -> IO ()) -> IO ())
-> (Ptr GObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
argPtr1 ->Ptr GObject -> CString -> Ptr GValue -> IO ()
g_object_set_property Ptr GObject
argPtr1 CString
arg2 Ptr GValue
arg3)
{-# LINE 133 "./System/Glib/Properties.chs" #-}
    (toGObject obj)
    CString
propPtr
    GValue
gvalue

objectGetPropertyInternal :: GObjectClass gobj => GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal :: forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
gtype GValue -> IO a
valueGet String
prop gobj
obj =
  String -> (CString -> IO a) -> IO a
forall a. String -> (CString -> IO a) -> IO a
withCString String
prop ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
propPtr ->
  (GValue -> IO a) -> IO a
forall b. (GValue -> IO b) -> IO b
allocaGValue ((GValue -> IO a) -> IO a) -> (GValue -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \GValue
gvalue -> do
  GValue -> GType -> IO ()
valueInit GValue
gvalue GType
gtype
  (\(GObject ForeignPtr GObject
arg1) CString
arg2 (GValue Ptr GValue
arg3) -> ForeignPtr GObject -> (Ptr GObject -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr GObject
arg1 ((Ptr GObject -> IO ()) -> IO ())
-> (Ptr GObject -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr GObject
argPtr1 ->Ptr GObject -> CString -> Ptr GValue -> IO ()
g_object_get_property Ptr GObject
argPtr1 CString
arg2 Ptr GValue
arg3)
{-# LINE 143 "./System/Glib/Properties.chs" #-}
    (toGObject obj)
    CString
propPtr
    GValue
gvalue
  GValue -> IO a
valueGet GValue
gvalue

objectSetPropertyInt :: GObjectClass gobj => String -> gobj -> Int -> IO ()
objectSetPropertyInt :: forall gobj. GObjectClass gobj => String -> gobj -> Int -> IO ()
objectSetPropertyInt = GType -> (GValue -> Int -> IO ()) -> String -> gobj -> Int -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.int GValue -> Int -> IO ()
valueSetInt

objectGetPropertyInt :: GObjectClass gobj => String -> gobj -> IO Int
objectGetPropertyInt :: forall gobj. GObjectClass gobj => String -> gobj -> IO Int
objectGetPropertyInt = GType -> (GValue -> IO Int) -> String -> gobj -> IO Int
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.int GValue -> IO Int
valueGetInt

objectSetPropertyUInt :: GObjectClass gobj => String -> gobj -> Int -> IO ()
objectSetPropertyUInt :: forall gobj. GObjectClass gobj => String -> gobj -> Int -> IO ()
objectSetPropertyUInt = GType -> (GValue -> Int -> IO ()) -> String -> gobj -> Int -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.uint (\GValue
gv Int
v -> GValue -> Word -> IO ()
valueSetUInt GValue
gv (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
v))

objectGetPropertyUInt :: GObjectClass gobj => String -> gobj -> IO Int
objectGetPropertyUInt :: forall gobj. GObjectClass gobj => String -> gobj -> IO Int
objectGetPropertyUInt = GType -> (GValue -> IO Int) -> String -> gobj -> IO Int
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.uint (\GValue
gv -> (Word -> Int) -> IO Word -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word -> IO Int) -> IO Word -> IO Int
forall a b. (a -> b) -> a -> b
$ GValue -> IO Word
valueGetUInt GValue
gv)

objectSetPropertyInt64 :: GObjectClass gobj => String -> gobj -> Int64 -> IO ()
objectSetPropertyInt64 :: forall gobj. GObjectClass gobj => String -> gobj -> Int64 -> IO ()
objectSetPropertyInt64 = GType
-> (GValue -> Int64 -> IO ()) -> String -> gobj -> Int64 -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.int64 GValue -> Int64 -> IO ()
valueSetInt64

objectGetPropertyInt64 :: GObjectClass gobj => String -> gobj -> IO Int64
objectGetPropertyInt64 :: forall gobj. GObjectClass gobj => String -> gobj -> IO Int64
objectGetPropertyInt64 = GType -> (GValue -> IO Int64) -> String -> gobj -> IO Int64
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.int64 GValue -> IO Int64
valueGetInt64

objectSetPropertyUInt64 :: GObjectClass gobj => String -> gobj -> Word64 -> IO ()
objectSetPropertyUInt64 :: forall gobj. GObjectClass gobj => String -> gobj -> Word64 -> IO ()
objectSetPropertyUInt64 = GType
-> (GValue -> Word64 -> IO ()) -> String -> gobj -> Word64 -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.uint64 (\GValue
gv Word64
v -> GValue -> Word64 -> IO ()
valueSetUInt64 GValue
gv (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v))

objectGetPropertyUInt64 :: GObjectClass gobj => String -> gobj -> IO Word64
objectGetPropertyUInt64 :: forall gobj. GObjectClass gobj => String -> gobj -> IO Word64
objectGetPropertyUInt64 = GType -> (GValue -> IO Word64) -> String -> gobj -> IO Word64
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.uint64 (\GValue
gv -> (Word64 -> Word64) -> IO Word64 -> IO Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO Word64 -> IO Word64) -> IO Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ GValue -> IO Word64
valueGetUInt64 GValue
gv)

objectSetPropertyChar :: GObjectClass gobj => String -> gobj -> Char -> IO ()
objectSetPropertyChar :: forall gobj. GObjectClass gobj => String -> gobj -> Char -> IO ()
objectSetPropertyChar = GType
-> (GValue -> Char -> IO ()) -> String -> gobj -> Char -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.uint (\GValue
gv Char
v -> GValue -> Word -> IO ()
valueSetUInt GValue
gv (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
v)))

objectGetPropertyChar :: GObjectClass gobj => String -> gobj -> IO Char
objectGetPropertyChar :: forall gobj. GObjectClass gobj => String -> gobj -> IO Char
objectGetPropertyChar = GType -> (GValue -> IO Char) -> String -> gobj -> IO Char
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.uint (\GValue
gv -> (Word -> Char) -> IO Word -> IO Char
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word -> Int) -> Word -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO Word -> IO Char) -> IO Word -> IO Char
forall a b. (a -> b) -> a -> b
$ GValue -> IO Word
valueGetUInt GValue
gv)

objectSetPropertyBool :: GObjectClass gobj => String -> gobj -> Bool -> IO ()
objectSetPropertyBool :: forall gobj. GObjectClass gobj => String -> gobj -> Bool -> IO ()
objectSetPropertyBool = GType
-> (GValue -> Bool -> IO ()) -> String -> gobj -> Bool -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.bool GValue -> Bool -> IO ()
valueSetBool

objectGetPropertyBool :: GObjectClass gobj => String -> gobj -> IO Bool
objectGetPropertyBool :: forall gobj. GObjectClass gobj => String -> gobj -> IO Bool
objectGetPropertyBool = GType -> (GValue -> IO Bool) -> String -> gobj -> IO Bool
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.bool GValue -> IO Bool
valueGetBool

objectSetPropertyEnum :: (GObjectClass gobj, Enum enum) => GType -> String -> gobj -> enum -> IO ()
objectSetPropertyEnum :: forall gobj enum.
(GObjectClass gobj, Enum enum) =>
GType -> String -> gobj -> enum -> IO ()
objectSetPropertyEnum GType
gtype = GType
-> (GValue -> enum -> IO ()) -> String -> gobj -> enum -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
gtype GValue -> enum -> IO ()
forall enum. Enum enum => GValue -> enum -> IO ()
valueSetEnum

objectGetPropertyEnum :: (GObjectClass gobj, Enum enum) => GType -> String -> gobj -> IO enum
objectGetPropertyEnum :: forall gobj enum.
(GObjectClass gobj, Enum enum) =>
GType -> String -> gobj -> IO enum
objectGetPropertyEnum GType
gtype = GType -> (GValue -> IO enum) -> String -> gobj -> IO enum
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
gtype GValue -> IO enum
forall enum. Enum enum => GValue -> IO enum
valueGetEnum

objectSetPropertyFlags :: (GObjectClass gobj, Flags flag) => GType -> String -> gobj -> [flag] -> IO ()
objectSetPropertyFlags :: forall gobj flag.
(GObjectClass gobj, Flags flag) =>
GType -> String -> gobj -> [flag] -> IO ()
objectSetPropertyFlags GType
gtype = GType
-> (GValue -> [flag] -> IO ()) -> String -> gobj -> [flag] -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
gtype GValue -> [flag] -> IO ()
forall flag. Flags flag => GValue -> [flag] -> IO ()
valueSetFlags

objectGetPropertyFlags :: (GObjectClass gobj, Flags flag) => GType -> String -> gobj -> IO [flag]
objectGetPropertyFlags :: forall gobj flag.
(GObjectClass gobj, Flags flag) =>
GType -> String -> gobj -> IO [flag]
objectGetPropertyFlags GType
gtype = GType -> (GValue -> IO [flag]) -> String -> gobj -> IO [flag]
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
gtype GValue -> IO [flag]
forall flag. Flags flag => GValue -> IO [flag]
valueGetFlags

objectSetPropertyFloat :: GObjectClass gobj => String -> gobj -> Float -> IO ()
objectSetPropertyFloat :: forall gobj. GObjectClass gobj => String -> gobj -> Float -> IO ()
objectSetPropertyFloat = GType
-> (GValue -> Float -> IO ()) -> String -> gobj -> Float -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.float GValue -> Float -> IO ()
valueSetFloat

objectGetPropertyFloat :: GObjectClass gobj => String -> gobj -> IO Float
objectGetPropertyFloat :: forall gobj. GObjectClass gobj => String -> gobj -> IO Float
objectGetPropertyFloat = GType -> (GValue -> IO Float) -> String -> gobj -> IO Float
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.float GValue -> IO Float
valueGetFloat

objectSetPropertyDouble :: GObjectClass gobj => String -> gobj -> Double -> IO ()
objectSetPropertyDouble :: forall gobj. GObjectClass gobj => String -> gobj -> Double -> IO ()
objectSetPropertyDouble = GType
-> (GValue -> Double -> IO ()) -> String -> gobj -> Double -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.double GValue -> Double -> IO ()
valueSetDouble

objectGetPropertyDouble :: GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble :: forall gobj. GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble = GType -> (GValue -> IO Double) -> String -> gobj -> IO Double
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.double GValue -> IO Double
valueGetDouble

objectSetPropertyString :: (GObjectClass gobj, GlibString string) => String -> gobj -> string -> IO ()
objectSetPropertyString :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> string -> IO ()
objectSetPropertyString = GType
-> (GValue -> string -> IO ()) -> String -> gobj -> string -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.string GValue -> string -> IO ()
forall string. GlibString string => GValue -> string -> IO ()
valueSetString

objectGetPropertyString :: (GObjectClass gobj, GlibString string) => String -> gobj -> IO string
objectGetPropertyString :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> IO string
objectGetPropertyString = GType -> (GValue -> IO string) -> String -> gobj -> IO string
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.string GValue -> IO string
forall string. GlibString string => GValue -> IO string
valueGetString

objectSetPropertyMaybeString :: (GObjectClass gobj, GlibString string) => String -> gobj -> Maybe string -> IO ()
objectSetPropertyMaybeString :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> Maybe string -> IO ()
objectSetPropertyMaybeString = GType
-> (GValue -> Maybe string -> IO ())
-> String
-> gobj
-> Maybe string
-> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.string GValue -> Maybe string -> IO ()
forall string. GlibString string => GValue -> Maybe string -> IO ()
valueSetMaybeString

objectGetPropertyMaybeString :: (GObjectClass gobj, GlibString string) => String -> gobj -> IO (Maybe string)
objectGetPropertyMaybeString :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> IO (Maybe string)
objectGetPropertyMaybeString = GType
-> (GValue -> IO (Maybe string))
-> String
-> gobj
-> IO (Maybe string)
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.string GValue -> IO (Maybe string)
forall string. GlibString string => GValue -> IO (Maybe string)
valueGetMaybeString

objectSetPropertyFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> string -> IO ()
objectSetPropertyFilePath :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> string -> IO ()
objectSetPropertyFilePath = GType
-> (GValue -> string -> IO ()) -> String -> gobj -> string -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.string GValue -> string -> IO ()
forall string. GlibFilePath string => GValue -> string -> IO ()
valueSetFilePath

objectGetPropertyFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> IO string
objectGetPropertyFilePath :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> IO string
objectGetPropertyFilePath = GType -> (GValue -> IO string) -> String -> gobj -> IO string
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.string GValue -> IO string
forall string. GlibFilePath string => GValue -> IO string
valueGetFilePath

objectSetPropertyMaybeFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> Maybe string -> IO ()
objectSetPropertyMaybeFilePath :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> Maybe string -> IO ()
objectSetPropertyMaybeFilePath = GType
-> (GValue -> Maybe string -> IO ())
-> String
-> gobj
-> Maybe string
-> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
GType.string GValue -> Maybe string -> IO ()
forall string.
GlibFilePath string =>
GValue -> Maybe string -> IO ()
valueSetMaybeFilePath

objectGetPropertyMaybeFilePath :: (GObjectClass gobj, GlibFilePath string) => String -> gobj -> IO (Maybe string)
objectGetPropertyMaybeFilePath :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> IO (Maybe string)
objectGetPropertyMaybeFilePath = GType
-> (GValue -> IO (Maybe string))
-> String
-> gobj
-> IO (Maybe string)
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
GType.string GValue -> IO (Maybe string)
forall string. GlibFilePath string => GValue -> IO (Maybe string)
valueGetMaybeFilePath

objectSetPropertyBoxedOpaque :: GObjectClass gobj => (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedOpaque :: forall gobj boxed.
GObjectClass gobj =>
(boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedOpaque boxed -> (Ptr boxed -> IO ()) -> IO ()
with GType
gtype = GType
-> (GValue -> boxed -> IO ()) -> String -> gobj -> boxed -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
gtype ((boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GValue -> boxed -> IO ()
forall boxed.
(boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GValue -> boxed -> IO ()
valueSetBoxed boxed -> (Ptr boxed -> IO ()) -> IO ()
with)

objectGetPropertyBoxedOpaque :: GObjectClass gobj => (Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedOpaque :: forall gobj boxed.
GObjectClass gobj =>
(Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedOpaque Ptr boxed -> IO boxed
peek GType
gtype = GType -> (GValue -> IO boxed) -> String -> gobj -> IO boxed
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
gtype ((Ptr boxed -> IO boxed) -> GValue -> IO boxed
forall boxed. (Ptr boxed -> IO boxed) -> GValue -> IO boxed
valueGetBoxed Ptr boxed -> IO boxed
peek)

objectSetPropertyBoxedStorable :: (GObjectClass gobj, Storable boxed) => GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedStorable :: forall gobj boxed.
(GObjectClass gobj, Storable boxed) =>
GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedStorable = (boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GType -> String -> gobj -> boxed -> IO ()
forall gobj boxed.
GObjectClass gobj =>
(boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedOpaque boxed -> (Ptr boxed -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with

objectGetPropertyBoxedStorable :: (GObjectClass gobj, Storable boxed) => GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedStorable :: forall gobj boxed.
(GObjectClass gobj, Storable boxed) =>
GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedStorable = (Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
forall gobj boxed.
GObjectClass gobj =>
(Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedOpaque Ptr boxed -> IO boxed
forall a. Storable a => Ptr a -> IO a
peek

objectSetPropertyGObject :: (GObjectClass gobj, GObjectClass gobj') => GType -> String -> gobj -> gobj' -> IO ()
objectSetPropertyGObject :: forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> gobj' -> IO ()
objectSetPropertyGObject GType
gtype = GType
-> (GValue -> gobj' -> IO ()) -> String -> gobj -> gobj' -> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
gtype GValue -> gobj' -> IO ()
forall gobj. GObjectClass gobj => GValue -> gobj -> IO ()
valueSetGObject

objectGetPropertyGObject :: (GObjectClass gobj, GObjectClass gobj') => GType -> String -> gobj -> IO gobj'
objectGetPropertyGObject :: forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> IO gobj'
objectGetPropertyGObject GType
gtype = GType -> (GValue -> IO gobj') -> String -> gobj -> IO gobj'
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
gtype GValue -> IO gobj'
forall gobj. GObjectClass gobj => GValue -> IO gobj
valueGetGObject

objectSetPropertyMaybeGObject :: (GObjectClass gobj, GObjectClass gobj') => GType -> String -> gobj -> (Maybe gobj') -> IO ()
objectSetPropertyMaybeGObject :: forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> Maybe gobj' -> IO ()
objectSetPropertyMaybeGObject GType
gtype = GType
-> (GValue -> Maybe gobj' -> IO ())
-> String
-> gobj
-> Maybe gobj'
-> IO ()
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> a -> IO ()) -> String -> gobj -> a -> IO ()
objectSetPropertyInternal GType
gtype GValue -> Maybe gobj' -> IO ()
forall gobj. GObjectClass gobj => GValue -> Maybe gobj -> IO ()
valueSetMaybeGObject

objectGetPropertyMaybeGObject :: (GObjectClass gobj, GObjectClass gobj') => GType -> String -> gobj -> IO (Maybe gobj')
objectGetPropertyMaybeGObject :: forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> IO (Maybe gobj')
objectGetPropertyMaybeGObject GType
gtype = GType
-> (GValue -> IO (Maybe gobj'))
-> String
-> gobj
-> IO (Maybe gobj')
forall gobj a.
GObjectClass gobj =>
GType -> (GValue -> IO a) -> String -> gobj -> IO a
objectGetPropertyInternal GType
gtype GValue -> IO (Maybe gobj')
forall gobj. GObjectClass gobj => GValue -> IO (Maybe gobj)
valueGetMaybeGObject


-- Convenience functions to make attribute implementations in the other modules
-- shorter and more easily extensible.
--

newAttrFromIntProperty :: GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty :: forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
propName =
  String
-> (gobj -> IO Int)
-> (gobj -> Int -> IO ())
-> ReadWriteAttr gobj Int Int
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO Int
forall gobj. GObjectClass gobj => String -> gobj -> IO Int
objectGetPropertyInt String
propName) (String -> gobj -> Int -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Int -> IO ()
objectSetPropertyInt String
propName)

readAttrFromIntProperty :: GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromIntProperty :: forall gobj. GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromIntProperty String
propName =
  String -> (gobj -> IO Int) -> ReadAttr gobj Int
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO Int
forall gobj. GObjectClass gobj => String -> gobj -> IO Int
objectGetPropertyInt String
propName)

newAttrFromUIntProperty :: GObjectClass gobj => String -> Attr gobj Int
newAttrFromUIntProperty :: forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromUIntProperty String
propName =
  String
-> (gobj -> IO Int)
-> (gobj -> Int -> IO ())
-> ReadWriteAttr gobj Int Int
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO Int
forall gobj. GObjectClass gobj => String -> gobj -> IO Int
objectGetPropertyUInt String
propName) (String -> gobj -> Int -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Int -> IO ()
objectSetPropertyUInt String
propName)

readAttrFromUIntProperty :: GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromUIntProperty :: forall gobj. GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromUIntProperty String
propName =
  String -> (gobj -> IO Int) -> ReadAttr gobj Int
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO Int
forall gobj. GObjectClass gobj => String -> gobj -> IO Int
objectGetPropertyUInt String
propName)

newAttrFromCharProperty :: GObjectClass gobj => String -> Attr gobj Char
newAttrFromCharProperty :: forall gobj. GObjectClass gobj => String -> Attr gobj Char
newAttrFromCharProperty String
propName =
  String
-> (gobj -> IO Char)
-> (gobj -> Char -> IO ())
-> ReadWriteAttr gobj Char Char
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO Char
forall gobj. GObjectClass gobj => String -> gobj -> IO Char
objectGetPropertyChar String
propName) (String -> gobj -> Char -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Char -> IO ()
objectSetPropertyChar String
propName)

readAttrFromCharProperty :: GObjectClass gobj => String -> ReadAttr gobj Char
readAttrFromCharProperty :: forall gobj. GObjectClass gobj => String -> ReadAttr gobj Char
readAttrFromCharProperty String
propName =
  String -> (gobj -> IO Char) -> ReadAttr gobj Char
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO Char
forall gobj. GObjectClass gobj => String -> gobj -> IO Char
objectGetPropertyChar String
propName)

writeAttrFromUIntProperty :: GObjectClass gobj => String -> WriteAttr gobj Int
writeAttrFromUIntProperty :: forall gobj. GObjectClass gobj => String -> WriteAttr gobj Int
writeAttrFromUIntProperty String
propName =
  String -> (gobj -> Int -> IO ()) -> WriteAttr gobj Int
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName (String -> gobj -> Int -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Int -> IO ()
objectSetPropertyUInt String
propName)

newAttrFromBoolProperty :: GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty :: forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
propName =
  String
-> (gobj -> IO Bool)
-> (gobj -> Bool -> IO ())
-> ReadWriteAttr gobj Bool Bool
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO Bool
forall gobj. GObjectClass gobj => String -> gobj -> IO Bool
objectGetPropertyBool String
propName) (String -> gobj -> Bool -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Bool -> IO ()
objectSetPropertyBool String
propName)

readAttrFromBoolProperty :: GObjectClass gobj => String -> ReadAttr gobj Bool
readAttrFromBoolProperty :: forall gobj. GObjectClass gobj => String -> ReadAttr gobj Bool
readAttrFromBoolProperty String
propName =
  String -> (gobj -> IO Bool) -> ReadAttr gobj Bool
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO Bool
forall gobj. GObjectClass gobj => String -> gobj -> IO Bool
objectGetPropertyBool String
propName)

newAttrFromFloatProperty :: GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty :: forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
propName =
  String
-> (gobj -> IO Float)
-> (gobj -> Float -> IO ())
-> ReadWriteAttr gobj Float Float
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO Float
forall gobj. GObjectClass gobj => String -> gobj -> IO Float
objectGetPropertyFloat String
propName) (String -> gobj -> Float -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Float -> IO ()
objectSetPropertyFloat String
propName)

readAttrFromFloatProperty :: GObjectClass gobj => String -> ReadAttr gobj Float
readAttrFromFloatProperty :: forall gobj. GObjectClass gobj => String -> ReadAttr gobj Float
readAttrFromFloatProperty String
propName =
  String -> (gobj -> IO Float) -> ReadAttr gobj Float
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO Float
forall gobj. GObjectClass gobj => String -> gobj -> IO Float
objectGetPropertyFloat String
propName)

newAttrFromDoubleProperty :: GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty :: forall gobj. GObjectClass gobj => String -> Attr gobj Double
newAttrFromDoubleProperty String
propName =
  String
-> (gobj -> IO Double)
-> (gobj -> Double -> IO ())
-> ReadWriteAttr gobj Double Double
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO Double
forall gobj. GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble String
propName) (String -> gobj -> Double -> IO ()
forall gobj. GObjectClass gobj => String -> gobj -> Double -> IO ()
objectSetPropertyDouble String
propName)

readAttrFromDoubleProperty :: GObjectClass gobj => String -> ReadAttr gobj Double
readAttrFromDoubleProperty :: forall gobj. GObjectClass gobj => String -> ReadAttr gobj Double
readAttrFromDoubleProperty String
propName =
  String -> (gobj -> IO Double) -> ReadAttr gobj Double
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO Double
forall gobj. GObjectClass gobj => String -> gobj -> IO Double
objectGetPropertyDouble String
propName)

newAttrFromEnumProperty :: (GObjectClass gobj, Enum enum) => String -> GType -> Attr gobj enum
newAttrFromEnumProperty :: forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> Attr gobj enum
newAttrFromEnumProperty String
propName GType
gtype =
  String
-> (gobj -> IO enum)
-> (gobj -> enum -> IO ())
-> ReadWriteAttr gobj enum enum
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (GType -> String -> gobj -> IO enum
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
GType -> String -> gobj -> IO enum
objectGetPropertyEnum GType
gtype String
propName) (GType -> String -> gobj -> enum -> IO ()
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
GType -> String -> gobj -> enum -> IO ()
objectSetPropertyEnum GType
gtype String
propName)

readAttrFromEnumProperty :: (GObjectClass gobj, Enum enum) => String -> GType -> ReadAttr gobj enum
readAttrFromEnumProperty :: forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> ReadAttr gobj enum
readAttrFromEnumProperty String
propName GType
gtype =
  String -> (gobj -> IO enum) -> ReadAttr gobj enum
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (GType -> String -> gobj -> IO enum
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
GType -> String -> gobj -> IO enum
objectGetPropertyEnum GType
gtype String
propName)

writeAttrFromEnumProperty :: (GObjectClass gobj, Enum enum) => String -> GType -> WriteAttr gobj enum
writeAttrFromEnumProperty :: forall gobj enum.
(GObjectClass gobj, Enum enum) =>
String -> GType -> WriteAttr gobj enum
writeAttrFromEnumProperty String
propName GType
gtype =
  String -> (gobj -> enum -> IO ()) -> WriteAttr gobj enum
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName (GType -> String -> gobj -> enum -> IO ()
forall gobj enum.
(GObjectClass gobj, Enum enum) =>
GType -> String -> gobj -> enum -> IO ()
objectSetPropertyEnum GType
gtype String
propName)

newAttrFromFlagsProperty :: (GObjectClass gobj, Flags flag) => String -> GType -> Attr gobj [flag]
newAttrFromFlagsProperty :: forall gobj flag.
(GObjectClass gobj, Flags flag) =>
String -> GType -> Attr gobj [flag]
newAttrFromFlagsProperty String
propName GType
gtype =
  String
-> (gobj -> IO [flag])
-> (gobj -> [flag] -> IO ())
-> ReadWriteAttr gobj [flag] [flag]
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (GType -> String -> gobj -> IO [flag]
forall gobj flag.
(GObjectClass gobj, Flags flag) =>
GType -> String -> gobj -> IO [flag]
objectGetPropertyFlags GType
gtype String
propName) (GType -> String -> gobj -> [flag] -> IO ()
forall gobj flag.
(GObjectClass gobj, Flags flag) =>
GType -> String -> gobj -> [flag] -> IO ()
objectSetPropertyFlags GType
gtype String
propName)

readAttrFromFlagsProperty :: (GObjectClass gobj, Flags flag) => String -> GType -> ReadAttr gobj [flag]
readAttrFromFlagsProperty :: forall gobj flag.
(GObjectClass gobj, Flags flag) =>
String -> GType -> ReadAttr gobj [flag]
readAttrFromFlagsProperty String
propName GType
gtype =
  String -> (gobj -> IO [flag]) -> ReadAttr gobj [flag]
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (GType -> String -> gobj -> IO [flag]
forall gobj flag.
(GObjectClass gobj, Flags flag) =>
GType -> String -> gobj -> IO [flag]
objectGetPropertyFlags GType
gtype String
propName)

newAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> Attr gobj string
newAttrFromStringProperty :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
propName =
  String
-> (gobj -> IO string)
-> (gobj -> string -> IO ())
-> ReadWriteAttr gobj string string
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> IO string
objectGetPropertyString String
propName) (String -> gobj -> string -> IO ()
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> string -> IO ()
objectSetPropertyString String
propName)

readAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> ReadAttr gobj string
readAttrFromStringProperty :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> ReadAttr gobj string
readAttrFromStringProperty String
propName =
  String -> (gobj -> IO string) -> ReadAttr gobj string
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> IO string
objectGetPropertyString String
propName)

writeAttrFromStringProperty :: (GObjectClass gobj, GlibString string) => String -> WriteAttr gobj string
writeAttrFromStringProperty :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> WriteAttr gobj string
writeAttrFromStringProperty String
propName =
  String -> (gobj -> string -> IO ()) -> WriteAttr gobj string
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName (String -> gobj -> string -> IO ()
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> string -> IO ()
objectSetPropertyString String
propName)

newAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> Attr gobj (Maybe string)
newAttrFromMaybeStringProperty :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj (Maybe string)
newAttrFromMaybeStringProperty String
propName =
  String
-> (gobj -> IO (Maybe string))
-> (gobj -> Maybe string -> IO ())
-> ReadWriteAttr gobj (Maybe string) (Maybe string)
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> IO (Maybe string)
objectGetPropertyMaybeString String
propName) (String -> gobj -> Maybe string -> IO ()
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> Maybe string -> IO ()
objectSetPropertyMaybeString String
propName)

readAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> ReadAttr gobj (Maybe string)
readAttrFromMaybeStringProperty :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> ReadAttr gobj (Maybe string)
readAttrFromMaybeStringProperty String
propName =
  String
-> (gobj -> IO (Maybe string)) -> ReadAttr gobj (Maybe string)
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> IO (Maybe string)
objectGetPropertyMaybeString String
propName)

writeAttrFromMaybeStringProperty :: (GObjectClass gobj, GlibString string) => String -> WriteAttr gobj (Maybe string)
writeAttrFromMaybeStringProperty :: forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> WriteAttr gobj (Maybe string)
writeAttrFromMaybeStringProperty String
propName =
  String
-> (gobj -> Maybe string -> IO ()) -> WriteAttr gobj (Maybe string)
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName (String -> gobj -> Maybe string -> IO ()
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> gobj -> Maybe string -> IO ()
objectSetPropertyMaybeString String
propName)

newAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> Attr gobj string
newAttrFromFilePathProperty :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> Attr gobj string
newAttrFromFilePathProperty String
propName =
  String
-> (gobj -> IO string)
-> (gobj -> string -> IO ())
-> ReadWriteAttr gobj string string
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO string
forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> IO string
objectGetPropertyFilePath String
propName) (String -> gobj -> string -> IO ()
forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> string -> IO ()
objectSetPropertyFilePath String
propName)

readAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> ReadAttr gobj string
readAttrFromFilePathProperty :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> ReadAttr gobj string
readAttrFromFilePathProperty String
propName =
  String -> (gobj -> IO string) -> ReadAttr gobj string
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO string
forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> IO string
objectGetPropertyFilePath String
propName)

writeAttrFromFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> WriteAttr gobj string
writeAttrFromFilePathProperty :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> WriteAttr gobj string
writeAttrFromFilePathProperty String
propName =
  String -> (gobj -> string -> IO ()) -> WriteAttr gobj string
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName (String -> gobj -> string -> IO ()
forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> string -> IO ()
objectSetPropertyFilePath String
propName)

newAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> Attr gobj (Maybe string)
newAttrFromMaybeFilePathProperty :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> Attr gobj (Maybe string)
newAttrFromMaybeFilePathProperty String
propName =
  String
-> (gobj -> IO (Maybe string))
-> (gobj -> Maybe string -> IO ())
-> ReadWriteAttr gobj (Maybe string) (Maybe string)
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (String -> gobj -> IO (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> IO (Maybe string)
objectGetPropertyMaybeFilePath String
propName) (String -> gobj -> Maybe string -> IO ()
forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> Maybe string -> IO ()
objectSetPropertyMaybeFilePath String
propName)

readAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> ReadAttr gobj (Maybe string)
readAttrFromMaybeFilePathProperty :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> ReadAttr gobj (Maybe string)
readAttrFromMaybeFilePathProperty String
propName =
  String
-> (gobj -> IO (Maybe string)) -> ReadAttr gobj (Maybe string)
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (String -> gobj -> IO (Maybe string)
forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> IO (Maybe string)
objectGetPropertyMaybeFilePath String
propName)

writeAttrFromMaybeFilePathProperty :: (GObjectClass gobj, GlibFilePath string) => String -> WriteAttr gobj (Maybe string)
writeAttrFromMaybeFilePathProperty :: forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> WriteAttr gobj (Maybe string)
writeAttrFromMaybeFilePathProperty String
propName =
  String
-> (gobj -> Maybe string -> IO ()) -> WriteAttr gobj (Maybe string)
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName (String -> gobj -> Maybe string -> IO ()
forall gobj string.
(GObjectClass gobj, GlibFilePath string) =>
String -> gobj -> Maybe string -> IO ()
objectSetPropertyMaybeFilePath String
propName)

newAttrFromBoxedOpaqueProperty :: GObjectClass gobj => (Ptr boxed -> IO boxed) -> (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> String -> GType -> Attr gobj boxed
newAttrFromBoxedOpaqueProperty :: forall gobj boxed.
GObjectClass gobj =>
(Ptr boxed -> IO boxed)
-> (boxed -> (Ptr boxed -> IO ()) -> IO ())
-> String
-> GType
-> Attr gobj boxed
newAttrFromBoxedOpaqueProperty Ptr boxed -> IO boxed
peek boxed -> (Ptr boxed -> IO ()) -> IO ()
with String
propName GType
gtype =
  String
-> (gobj -> IO boxed)
-> (gobj -> boxed -> IO ())
-> ReadWriteAttr gobj boxed boxed
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName ((Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
forall gobj boxed.
GObjectClass gobj =>
(Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedOpaque Ptr boxed -> IO boxed
peek GType
gtype String
propName) ((boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GType -> String -> gobj -> boxed -> IO ()
forall gobj boxed.
GObjectClass gobj =>
(boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedOpaque boxed -> (Ptr boxed -> IO ()) -> IO ()
with GType
gtype String
propName)

readAttrFromBoxedOpaqueProperty :: GObjectClass gobj => (Ptr boxed -> IO boxed) -> String -> GType -> ReadAttr gobj boxed
readAttrFromBoxedOpaqueProperty :: forall gobj boxed.
GObjectClass gobj =>
(Ptr boxed -> IO boxed) -> String -> GType -> ReadAttr gobj boxed
readAttrFromBoxedOpaqueProperty Ptr boxed -> IO boxed
peek String
propName GType
gtype =
  String -> (gobj -> IO boxed) -> ReadAttr gobj boxed
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName ((Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
forall gobj boxed.
GObjectClass gobj =>
(Ptr boxed -> IO boxed) -> GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedOpaque Ptr boxed -> IO boxed
peek GType
gtype String
propName)

writeAttrFromBoxedOpaqueProperty :: GObjectClass gobj => (boxed -> (Ptr boxed -> IO ()) -> IO ()) -> String -> GType -> WriteAttr gobj boxed
writeAttrFromBoxedOpaqueProperty :: forall gobj boxed.
GObjectClass gobj =>
(boxed -> (Ptr boxed -> IO ()) -> IO ())
-> String -> GType -> WriteAttr gobj boxed
writeAttrFromBoxedOpaqueProperty boxed -> (Ptr boxed -> IO ()) -> IO ()
with String
propName GType
gtype =
  String -> (gobj -> boxed -> IO ()) -> WriteAttr gobj boxed
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName ((boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GType -> String -> gobj -> boxed -> IO ()
forall gobj boxed.
GObjectClass gobj =>
(boxed -> (Ptr boxed -> IO ()) -> IO ())
-> GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedOpaque boxed -> (Ptr boxed -> IO ()) -> IO ()
with GType
gtype String
propName)

newAttrFromBoxedStorableProperty :: (GObjectClass gobj, Storable boxed) => String -> GType -> Attr gobj boxed
newAttrFromBoxedStorableProperty :: forall gobj boxed.
(GObjectClass gobj, Storable boxed) =>
String -> GType -> Attr gobj boxed
newAttrFromBoxedStorableProperty String
propName GType
gtype =
  String
-> (gobj -> IO boxed)
-> (gobj -> boxed -> IO ())
-> ReadWriteAttr gobj boxed boxed
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (GType -> String -> gobj -> IO boxed
forall gobj boxed.
(GObjectClass gobj, Storable boxed) =>
GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedStorable GType
gtype String
propName) (GType -> String -> gobj -> boxed -> IO ()
forall gobj boxed.
(GObjectClass gobj, Storable boxed) =>
GType -> String -> gobj -> boxed -> IO ()
objectSetPropertyBoxedStorable GType
gtype String
propName)

readAttrFromBoxedStorableProperty :: (GObjectClass gobj, Storable boxed) => String -> GType -> ReadAttr gobj boxed
readAttrFromBoxedStorableProperty :: forall gobj boxed.
(GObjectClass gobj, Storable boxed) =>
String -> GType -> ReadAttr gobj boxed
readAttrFromBoxedStorableProperty String
propName GType
gtype =
  String -> (gobj -> IO boxed) -> ReadAttr gobj boxed
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (GType -> String -> gobj -> IO boxed
forall gobj boxed.
(GObjectClass gobj, Storable boxed) =>
GType -> String -> gobj -> IO boxed
objectGetPropertyBoxedStorable GType
gtype String
propName)

newAttrFromObjectProperty :: (GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') => String -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty :: forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> GType -> ReadWriteAttr gobj gobj' gobj''
newAttrFromObjectProperty String
propName GType
gtype =
  String
-> (gobj -> IO gobj')
-> (gobj -> gobj'' -> IO ())
-> ReadWriteAttr gobj gobj' gobj''
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (GType -> String -> gobj -> IO gobj'
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> IO gobj'
objectGetPropertyGObject GType
gtype String
propName) (GType -> String -> gobj -> gobj'' -> IO ()
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> gobj' -> IO ()
objectSetPropertyGObject GType
gtype String
propName)

writeAttrFromObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> WriteAttr gobj gobj'
writeAttrFromObjectProperty :: forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
String -> GType -> WriteAttr gobj gobj'
writeAttrFromObjectProperty String
propName GType
gtype =
  String -> (gobj -> gobj' -> IO ()) -> WriteAttr gobj gobj'
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName (GType -> String -> gobj -> gobj' -> IO ()
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> gobj' -> IO ()
objectSetPropertyGObject GType
gtype String
propName)

readAttrFromObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> ReadAttr gobj gobj'
readAttrFromObjectProperty :: forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
String -> GType -> ReadAttr gobj gobj'
readAttrFromObjectProperty String
propName GType
gtype =
  String -> (gobj -> IO gobj') -> ReadAttr gobj gobj'
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (GType -> String -> gobj -> IO gobj'
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> IO gobj'
objectGetPropertyGObject GType
gtype String
propName)

newAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') => String -> GType -> ReadWriteAttr gobj (Maybe gobj') (Maybe gobj'')
newAttrFromMaybeObjectProperty :: forall gobj gobj' gobj''.
(GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') =>
String -> GType -> ReadWriteAttr gobj (Maybe gobj') (Maybe gobj'')
newAttrFromMaybeObjectProperty String
propName GType
gtype =
  String
-> (gobj -> IO (Maybe gobj'))
-> (gobj -> Maybe gobj'' -> IO ())
-> ReadWriteAttr gobj (Maybe gobj') (Maybe gobj'')
forall o a b.
String -> (o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newNamedAttr String
propName (GType -> String -> gobj -> IO (Maybe gobj')
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> IO (Maybe gobj')
objectGetPropertyMaybeGObject GType
gtype String
propName) (GType -> String -> gobj -> Maybe gobj'' -> IO ()
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> Maybe gobj' -> IO ()
objectSetPropertyMaybeGObject GType
gtype String
propName)

writeAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> WriteAttr gobj (Maybe gobj')
writeAttrFromMaybeObjectProperty :: forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
String -> GType -> WriteAttr gobj (Maybe gobj')
writeAttrFromMaybeObjectProperty String
propName GType
gtype =
  String
-> (gobj -> Maybe gobj' -> IO ()) -> WriteAttr gobj (Maybe gobj')
forall o b. String -> (o -> b -> IO ()) -> WriteAttr o b
writeNamedAttr String
propName (GType -> String -> gobj -> Maybe gobj' -> IO ()
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> Maybe gobj' -> IO ()
objectSetPropertyMaybeGObject GType
gtype String
propName)

readAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> ReadAttr gobj (Maybe gobj')
readAttrFromMaybeObjectProperty :: forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
String -> GType -> ReadAttr gobj (Maybe gobj')
readAttrFromMaybeObjectProperty String
propName GType
gtype =
  String -> (gobj -> IO (Maybe gobj')) -> ReadAttr gobj (Maybe gobj')
forall o a. String -> (o -> IO a) -> ReadAttr o a
readNamedAttr String
propName (GType -> String -> gobj -> IO (Maybe gobj')
forall gobj gobj'.
(GObjectClass gobj, GObjectClass gobj') =>
GType -> String -> gobj -> IO (Maybe gobj')
objectGetPropertyMaybeGObject GType
gtype String
propName)

foreign import ccall safe "g_object_set_property"
  g_object_set_property :: ((Ptr GObject) -> ((Ptr CChar) -> ((Ptr GValue) -> (IO ()))))

foreign import ccall unsafe "g_object_get_property"
  g_object_get_property :: ((Ptr GObject) -> ((Ptr CChar) -> ((Ptr GValue) -> (IO ()))))