{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Dazzle.Interfaces.Preferences
    ( 

-- * Exported types
    Preferences(..)                         ,
    IsPreferences                           ,
    toPreferences                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addCustom]("GI.Dazzle.Interfaces.Preferences#g:method:addCustom"), [addFileChooser]("GI.Dazzle.Interfaces.Preferences#g:method:addFileChooser"), [addFontButton]("GI.Dazzle.Interfaces.Preferences#g:method:addFontButton"), [addGroup]("GI.Dazzle.Interfaces.Preferences#g:method:addGroup"), [addListGroup]("GI.Dazzle.Interfaces.Preferences#g:method:addListGroup"), [addPage]("GI.Dazzle.Interfaces.Preferences#g:method:addPage"), [addRadio]("GI.Dazzle.Interfaces.Preferences#g:method:addRadio"), [addSpinButton]("GI.Dazzle.Interfaces.Preferences#g:method:addSpinButton"), [addSwitch]("GI.Dazzle.Interfaces.Preferences#g:method:addSwitch"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [removeId]("GI.Dazzle.Interfaces.Preferences#g:method:removeId"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getWidget]("GI.Dazzle.Interfaces.Preferences#g:method:getWidget").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setPage]("GI.Dazzle.Interfaces.Preferences#g:method:setPage"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePreferencesMethod                ,
#endif

-- ** addCustom #method:addCustom#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddCustomMethodInfo          ,
#endif
    preferencesAddCustom                    ,


-- ** addFileChooser #method:addFileChooser#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddFileChooserMethodInfo     ,
#endif
    preferencesAddFileChooser               ,


-- ** addFontButton #method:addFontButton#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddFontButtonMethodInfo      ,
#endif
    preferencesAddFontButton                ,


-- ** addGroup #method:addGroup#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddGroupMethodInfo           ,
#endif
    preferencesAddGroup                     ,


-- ** addListGroup #method:addListGroup#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddListGroupMethodInfo       ,
#endif
    preferencesAddListGroup                 ,


-- ** addPage #method:addPage#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddPageMethodInfo            ,
#endif
    preferencesAddPage                      ,


-- ** addRadio #method:addRadio#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddRadioMethodInfo           ,
#endif
    preferencesAddRadio                     ,


-- ** addSpinButton #method:addSpinButton#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddSpinButtonMethodInfo      ,
#endif
    preferencesAddSpinButton                ,


-- ** addSwitch #method:addSwitch#

#if defined(ENABLE_OVERLOADING)
    PreferencesAddSwitchMethodInfo          ,
#endif
    preferencesAddSwitch                    ,


-- ** getWidget #method:getWidget#

#if defined(ENABLE_OVERLOADING)
    PreferencesGetWidgetMethodInfo          ,
#endif
    preferencesGetWidget                    ,


-- ** removeId #method:removeId#

#if defined(ENABLE_OVERLOADING)
    PreferencesRemoveIdMethodInfo           ,
#endif
    preferencesRemoveId                     ,


-- ** setPage #method:setPage#

#if defined(ENABLE_OVERLOADING)
    PreferencesSetPageMethodInfo            ,
#endif
    preferencesSetPage                      ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Enums as Gtk.Enums
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Enums as Gtk.Enums
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

-- interface Preferences 
-- | Memory-managed wrapper type.
newtype Preferences = Preferences (SP.ManagedPtr Preferences)
    deriving (Preferences -> Preferences -> Bool
(Preferences -> Preferences -> Bool)
-> (Preferences -> Preferences -> Bool) -> Eq Preferences
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Preferences -> Preferences -> Bool
== :: Preferences -> Preferences -> Bool
$c/= :: Preferences -> Preferences -> Bool
/= :: Preferences -> Preferences -> Bool
Eq)

instance SP.ManagedPtrNewtype Preferences where
    toManagedPtr :: Preferences -> ManagedPtr Preferences
toManagedPtr (Preferences ManagedPtr Preferences
p) = ManagedPtr Preferences
p

foreign import ccall "dzl_preferences_get_type"
    c_dzl_preferences_get_type :: IO B.Types.GType

instance B.Types.TypedObject Preferences where
    glibType :: IO GType
glibType = IO GType
c_dzl_preferences_get_type

instance B.Types.GObject Preferences

-- | Type class for types which can be safely cast to `Preferences`, for instance with `toPreferences`.
class (SP.GObject o, O.IsDescendantOf Preferences o) => IsPreferences o
instance (SP.GObject o, O.IsDescendantOf Preferences o) => IsPreferences o

instance O.HasParentTypes Preferences
type instance O.ParentTypes Preferences = '[GObject.Object.Object]

-- | Cast to `Preferences`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toPreferences :: (MIO.MonadIO m, IsPreferences o) => o -> m Preferences
toPreferences :: forall (m :: * -> *) o.
(MonadIO m, IsPreferences o) =>
o -> m Preferences
toPreferences = IO Preferences -> m Preferences
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Preferences -> m Preferences)
-> (o -> IO Preferences) -> o -> m Preferences
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Preferences -> Preferences) -> o -> IO Preferences
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr Preferences -> Preferences
Preferences

-- | Convert 'Preferences' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Preferences) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_preferences_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Preferences -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Preferences
P.Nothing = Ptr GValue -> Ptr Preferences -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Preferences
forall a. Ptr a
FP.nullPtr :: FP.Ptr Preferences)
    gvalueSet_ Ptr GValue
gv (P.Just Preferences
obj) = Preferences -> (Ptr Preferences -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Preferences
obj (Ptr GValue -> Ptr Preferences -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Preferences)
gvalueGet_ Ptr GValue
gv = do
        Ptr Preferences
ptr <- Ptr GValue -> IO (Ptr Preferences)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Preferences)
        if Ptr Preferences
ptr Ptr Preferences -> Ptr Preferences -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Preferences
forall a. Ptr a
FP.nullPtr
        then Preferences -> Maybe Preferences
forall a. a -> Maybe a
P.Just (Preferences -> Maybe Preferences)
-> IO Preferences -> IO (Maybe Preferences)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Preferences -> Preferences)
-> Ptr Preferences -> IO Preferences
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Preferences -> Preferences
Preferences Ptr Preferences
ptr
        else Maybe Preferences -> IO (Maybe Preferences)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Preferences
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Preferences
type instance O.AttributeList Preferences = PreferencesAttributeList
type PreferencesAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolvePreferencesMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePreferencesMethod "addCustom" o = PreferencesAddCustomMethodInfo
    ResolvePreferencesMethod "addFileChooser" o = PreferencesAddFileChooserMethodInfo
    ResolvePreferencesMethod "addFontButton" o = PreferencesAddFontButtonMethodInfo
    ResolvePreferencesMethod "addGroup" o = PreferencesAddGroupMethodInfo
    ResolvePreferencesMethod "addListGroup" o = PreferencesAddListGroupMethodInfo
    ResolvePreferencesMethod "addPage" o = PreferencesAddPageMethodInfo
    ResolvePreferencesMethod "addRadio" o = PreferencesAddRadioMethodInfo
    ResolvePreferencesMethod "addSpinButton" o = PreferencesAddSpinButtonMethodInfo
    ResolvePreferencesMethod "addSwitch" o = PreferencesAddSwitchMethodInfo
    ResolvePreferencesMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePreferencesMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePreferencesMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePreferencesMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePreferencesMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePreferencesMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePreferencesMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePreferencesMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePreferencesMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePreferencesMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePreferencesMethod "removeId" o = PreferencesRemoveIdMethodInfo
    ResolvePreferencesMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePreferencesMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePreferencesMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePreferencesMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePreferencesMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePreferencesMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePreferencesMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePreferencesMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePreferencesMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePreferencesMethod "getWidget" o = PreferencesGetWidgetMethodInfo
    ResolvePreferencesMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePreferencesMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePreferencesMethod "setPage" o = PreferencesSetPageMethodInfo
    ResolvePreferencesMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePreferencesMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolvePreferencesMethod t Preferences, O.OverloadedMethod info Preferences p) => OL.IsLabel t (Preferences -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePreferencesMethod t Preferences, O.OverloadedMethod info Preferences p, R.HasField t Preferences p) => R.HasField t Preferences p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolvePreferencesMethod t Preferences, O.OverloadedMethodInfo info Preferences) => OL.IsLabel t (O.MethodProxy info Preferences) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- method Preferences::add_custom
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget"
--           , argType = TInterface Name { namespace = "Gtk" , name = "Widget" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keywords"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Optional keywords for search"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_custom" dzl_preferences_add_custom :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- group_name : TBasicType TUTF8
    Ptr Gtk.Widget.Widget ->                -- widget : TInterface (Name {namespace = "Gtk", name = "Widget"})
    CString ->                              -- keywords : TBasicType TUTF8
    Int32 ->                                -- priority : TBasicType TInt
    IO Word32

-- | /No description available in the introspection data./
preferencesAddCustom ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a, Gtk.Widget.IsWidget b) =>
    a
    -> T.Text
    -> T.Text
    -> b
    -> Maybe (T.Text)
    -- ^ /@keywords@/: Optional keywords for search
    -> Int32
    -> m Word32
preferencesAddCustom :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPreferences a, IsWidget b) =>
a -> Text -> Text -> b -> Maybe Text -> Int32 -> m Word32
preferencesAddCustom a
self Text
pageName Text
groupName b
widget Maybe Text
keywords Int32
priority = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
groupName' <- Text -> IO CString
textToCString Text
groupName
    Ptr Widget
widget' <- b -> IO (Ptr Widget)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
widget
    CString
maybeKeywords <- case Maybe Text
keywords of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jKeywords -> do
            CString
jKeywords' <- Text -> IO CString
textToCString Text
jKeywords
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jKeywords'
    Word32
result <- Ptr Preferences
-> CString
-> CString
-> Ptr Widget
-> CString
-> Int32
-> IO Word32
dzl_preferences_add_custom Ptr Preferences
self' CString
pageName' CString
groupName' Ptr Widget
widget' CString
maybeKeywords Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
widget
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
groupName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeKeywords
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PreferencesAddCustomMethodInfo
instance (signature ~ (T.Text -> T.Text -> b -> Maybe (T.Text) -> Int32 -> m Word32), MonadIO m, IsPreferences a, Gtk.Widget.IsWidget b) => O.OverloadedMethod PreferencesAddCustomMethodInfo a signature where
    overloadedMethod = preferencesAddCustom

instance O.OverloadedMethodInfo PreferencesAddCustomMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddCustom",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddCustom"
        })


#endif

-- method Preferences::add_file_chooser
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subtitle"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "action"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "FileChooserAction" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keywords"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_file_chooser" dzl_preferences_add_file_chooser :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- group_name : TBasicType TUTF8
    CString ->                              -- schema_id : TBasicType TUTF8
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- path : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    CString ->                              -- subtitle : TBasicType TUTF8
    CUInt ->                                -- action : TInterface (Name {namespace = "Gtk", name = "FileChooserAction"})
    CString ->                              -- keywords : TBasicType TUTF8
    Int32 ->                                -- priority : TBasicType TInt
    IO Word32

-- | /No description available in the introspection data./
preferencesAddFileChooser ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> Gtk.Enums.FileChooserAction
    -> T.Text
    -> Int32
    -> m Word32
preferencesAddFileChooser :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> FileChooserAction
-> Text
-> Int32
-> m Word32
preferencesAddFileChooser a
self Text
pageName Text
groupName Text
schemaId Text
key Text
path Text
title Text
subtitle FileChooserAction
action Text
keywords Int32
priority = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
groupName' <- Text -> IO CString
textToCString Text
groupName
    CString
schemaId' <- Text -> IO CString
textToCString Text
schemaId
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
path' <- Text -> IO CString
textToCString Text
path
    CString
title' <- Text -> IO CString
textToCString Text
title
    CString
subtitle' <- Text -> IO CString
textToCString Text
subtitle
    let action' :: CUInt
action' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (FileChooserAction -> Int) -> FileChooserAction -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileChooserAction -> Int
forall a. Enum a => a -> Int
fromEnum) FileChooserAction
action
    CString
keywords' <- Text -> IO CString
textToCString Text
keywords
    Word32
result <- Ptr Preferences
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CUInt
-> CString
-> Int32
-> IO Word32
dzl_preferences_add_file_chooser Ptr Preferences
self' CString
pageName' CString
groupName' CString
schemaId' CString
key' CString
path' CString
title' CString
subtitle' CUInt
action' CString
keywords' Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
groupName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
schemaId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
subtitle'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keywords'
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PreferencesAddFileChooserMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> Gtk.Enums.FileChooserAction -> T.Text -> Int32 -> m Word32), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesAddFileChooserMethodInfo a signature where
    overloadedMethod = preferencesAddFileChooser

instance O.OverloadedMethodInfo PreferencesAddFileChooserMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddFileChooser",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddFileChooser"
        })


#endif

-- method Preferences::add_font_button
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keywords"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_font_button" dzl_preferences_add_font_button :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- group_name : TBasicType TUTF8
    CString ->                              -- schema_id : TBasicType TUTF8
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    CString ->                              -- keywords : TBasicType TUTF8
    Int32 ->                                -- priority : TBasicType TInt
    IO Word32

-- | /No description available in the introspection data./
preferencesAddFontButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> Int32
    -> m Word32
preferencesAddFontButton :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int32
-> m Word32
preferencesAddFontButton a
self Text
pageName Text
groupName Text
schemaId Text
key Text
title Text
keywords Int32
priority = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
groupName' <- Text -> IO CString
textToCString Text
groupName
    CString
schemaId' <- Text -> IO CString
textToCString Text
schemaId
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
title' <- Text -> IO CString
textToCString Text
title
    CString
keywords' <- Text -> IO CString
textToCString Text
keywords
    Word32
result <- Ptr Preferences
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> Int32
-> IO Word32
dzl_preferences_add_font_button Ptr Preferences
self' CString
pageName' CString
groupName' CString
schemaId' CString
key' CString
title' CString
keywords' Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
groupName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
schemaId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keywords'
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PreferencesAddFontButtonMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> Int32 -> m Word32), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesAddFontButtonMethodInfo a signature where
    overloadedMethod = preferencesAddFontButton

instance O.OverloadedMethodInfo PreferencesAddFontButtonMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddFontButton",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddFontButton"
        })


#endif

-- method Preferences::add_group
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_group" dzl_preferences_add_group :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- group_name : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    Int32 ->                                -- priority : TBasicType TInt
    IO ()

-- | /No description available in the introspection data./
preferencesAddGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> Int32
    -> m ()
preferencesAddGroup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a -> Text -> Text -> Text -> Int32 -> m ()
preferencesAddGroup a
self Text
pageName Text
groupName Text
title Int32
priority = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
groupName' <- Text -> IO CString
textToCString Text
groupName
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr Preferences -> CString -> CString -> CString -> Int32 -> IO ()
dzl_preferences_add_group Ptr Preferences
self' CString
pageName' CString
groupName' CString
title' Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
groupName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PreferencesAddGroupMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> Int32 -> m ()), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesAddGroupMethodInfo a signature where
    overloadedMethod = preferencesAddGroup

instance O.OverloadedMethodInfo PreferencesAddGroupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddGroup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddGroup"
        })


#endif

-- method Preferences::add_list_group
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "SelectionMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_list_group" dzl_preferences_add_list_group :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- group_name : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    CUInt ->                                -- mode : TInterface (Name {namespace = "Gtk", name = "SelectionMode"})
    Int32 ->                                -- priority : TBasicType TInt
    IO ()

-- | /No description available in the introspection data./
preferencesAddListGroup ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> Gtk.Enums.SelectionMode
    -> Int32
    -> m ()
preferencesAddListGroup :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a -> Text -> Text -> Text -> SelectionMode -> Int32 -> m ()
preferencesAddListGroup a
self Text
pageName Text
groupName Text
title SelectionMode
mode Int32
priority = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
groupName' <- Text -> IO CString
textToCString Text
groupName
    CString
title' <- Text -> IO CString
textToCString Text
title
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (SelectionMode -> Int) -> SelectionMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionMode -> Int
forall a. Enum a => a -> Int
fromEnum) SelectionMode
mode
    Ptr Preferences
-> CString -> CString -> CString -> CUInt -> Int32 -> IO ()
dzl_preferences_add_list_group Ptr Preferences
self' CString
pageName' CString
groupName' CString
title' CUInt
mode' Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
groupName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PreferencesAddListGroupMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> Gtk.Enums.SelectionMode -> Int32 -> m ()), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesAddListGroupMethodInfo a signature where
    overloadedMethod = preferencesAddListGroup

instance O.OverloadedMethodInfo PreferencesAddListGroupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddListGroup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddListGroup"
        })


#endif

-- method Preferences::add_page
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_page" dzl_preferences_add_page :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    Int32 ->                                -- priority : TBasicType TInt
    IO ()

-- | /No description available in the introspection data./
preferencesAddPage ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> T.Text
    -> Int32
    -> m ()
preferencesAddPage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a -> Text -> Text -> Int32 -> m ()
preferencesAddPage a
self Text
pageName Text
title Int32
priority = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
title' <- Text -> IO CString
textToCString Text
title
    Ptr Preferences -> CString -> CString -> Int32 -> IO ()
dzl_preferences_add_page Ptr Preferences
self' CString
pageName' CString
title' Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PreferencesAddPageMethodInfo
instance (signature ~ (T.Text -> T.Text -> Int32 -> m ()), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesAddPageMethodInfo a signature where
    overloadedMethod = preferencesAddPage

instance O.OverloadedMethodInfo PreferencesAddPageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddPage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddPage"
        })


#endif

-- method Preferences::add_radio
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "variant_string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional gvariant string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subtitle"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional subtitle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keywords"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Optional keywords for search"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_radio" dzl_preferences_add_radio :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- group_name : TBasicType TUTF8
    CString ->                              -- schema_id : TBasicType TUTF8
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- path : TBasicType TUTF8
    CString ->                              -- variant_string : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    CString ->                              -- subtitle : TBasicType TUTF8
    CString ->                              -- keywords : TBasicType TUTF8
    Int32 ->                                -- priority : TBasicType TInt
    IO Word32

-- | /No description available in the introspection data./
preferencesAddRadio ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> Maybe (T.Text)
    -- ^ /@path@/: An optional path
    -> Maybe (T.Text)
    -- ^ /@variantString@/: An optional gvariant string
    -> Maybe (T.Text)
    -- ^ /@title@/: An optional title
    -> Maybe (T.Text)
    -- ^ /@subtitle@/: An optional subtitle
    -> Maybe (T.Text)
    -- ^ /@keywords@/: Optional keywords for search
    -> Int32
    -> m Word32
preferencesAddRadio :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a
-> Text
-> Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int32
-> m Word32
preferencesAddRadio a
self Text
pageName Text
groupName Text
schemaId Text
key Maybe Text
path Maybe Text
variantString Maybe Text
title Maybe Text
subtitle Maybe Text
keywords Int32
priority = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
groupName' <- Text -> IO CString
textToCString Text
groupName
    CString
schemaId' <- Text -> IO CString
textToCString Text
schemaId
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            CString
jPath' <- Text -> IO CString
textToCString Text
jPath
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPath'
    CString
maybeVariantString <- case Maybe Text
variantString of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jVariantString -> do
            CString
jVariantString' <- Text -> IO CString
textToCString Text
jVariantString
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jVariantString'
    CString
maybeTitle <- case Maybe Text
title of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTitle -> do
            CString
jTitle' <- Text -> IO CString
textToCString Text
jTitle
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTitle'
    CString
maybeSubtitle <- case Maybe Text
subtitle of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jSubtitle -> do
            CString
jSubtitle' <- Text -> IO CString
textToCString Text
jSubtitle
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jSubtitle'
    CString
maybeKeywords <- case Maybe Text
keywords of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jKeywords -> do
            CString
jKeywords' <- Text -> IO CString
textToCString Text
jKeywords
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jKeywords'
    Word32
result <- Ptr Preferences
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> Int32
-> IO Word32
dzl_preferences_add_radio Ptr Preferences
self' CString
pageName' CString
groupName' CString
schemaId' CString
key' CString
maybePath CString
maybeVariantString CString
maybeTitle CString
maybeSubtitle CString
maybeKeywords Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
groupName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
schemaId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePath
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeVariantString
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTitle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSubtitle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeKeywords
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PreferencesAddRadioMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> T.Text -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Int32 -> m Word32), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesAddRadioMethodInfo a signature where
    overloadedMethod = preferencesAddRadio

instance O.OverloadedMethodInfo PreferencesAddRadioMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddRadio",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddRadio"
        })


#endif

-- method Preferences::add_spin_button
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subtitle"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keywords"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_spin_button" dzl_preferences_add_spin_button :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- group_name : TBasicType TUTF8
    CString ->                              -- schema_id : TBasicType TUTF8
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- path : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    CString ->                              -- subtitle : TBasicType TUTF8
    CString ->                              -- keywords : TBasicType TUTF8
    Int32 ->                                -- priority : TBasicType TInt
    IO Word32

-- | /No description available in the introspection data./
preferencesAddSpinButton ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> Int32
    -> m Word32
preferencesAddSpinButton :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Int32
-> m Word32
preferencesAddSpinButton a
self Text
pageName Text
groupName Text
schemaId Text
key Text
path Text
title Text
subtitle Text
keywords Int32
priority = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
groupName' <- Text -> IO CString
textToCString Text
groupName
    CString
schemaId' <- Text -> IO CString
textToCString Text
schemaId
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
path' <- Text -> IO CString
textToCString Text
path
    CString
title' <- Text -> IO CString
textToCString Text
title
    CString
subtitle' <- Text -> IO CString
textToCString Text
subtitle
    CString
keywords' <- Text -> IO CString
textToCString Text
keywords
    Word32
result <- Ptr Preferences
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> Int32
-> IO Word32
dzl_preferences_add_spin_button Ptr Preferences
self' CString
pageName' CString
groupName' CString
schemaId' CString
key' CString
path' CString
title' CString
subtitle' CString
keywords' Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
groupName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
schemaId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
title'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
subtitle'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keywords'
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PreferencesAddSpinButtonMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> T.Text -> Int32 -> m Word32), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesAddSpinButtonMethodInfo a signature where
    overloadedMethod = preferencesAddSpinButton

instance O.OverloadedMethodInfo PreferencesAddSpinButtonMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddSpinButton",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddSpinButton"
        })


#endif

-- method Preferences::add_switch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "group_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "schema_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "variant_string"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional gvariant string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "title"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional title" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subtitle"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An optional subtitle"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keywords"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Optional keywords for search"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "priority"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_add_switch" dzl_preferences_add_switch :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    CString ->                              -- group_name : TBasicType TUTF8
    CString ->                              -- schema_id : TBasicType TUTF8
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- path : TBasicType TUTF8
    CString ->                              -- variant_string : TBasicType TUTF8
    CString ->                              -- title : TBasicType TUTF8
    CString ->                              -- subtitle : TBasicType TUTF8
    CString ->                              -- keywords : TBasicType TUTF8
    Int32 ->                                -- priority : TBasicType TInt
    IO Word32

-- | /No description available in the introspection data./
preferencesAddSwitch ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> T.Text
    -> T.Text
    -> T.Text
    -> Maybe (T.Text)
    -- ^ /@path@/: An optional path
    -> Maybe (T.Text)
    -- ^ /@variantString@/: An optional gvariant string
    -> Maybe (T.Text)
    -- ^ /@title@/: An optional title
    -> Maybe (T.Text)
    -- ^ /@subtitle@/: An optional subtitle
    -> Maybe (T.Text)
    -- ^ /@keywords@/: Optional keywords for search
    -> Int32
    -> m Word32
preferencesAddSwitch :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a
-> Text
-> Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int32
-> m Word32
preferencesAddSwitch a
self Text
pageName Text
groupName Text
schemaId Text
key Maybe Text
path Maybe Text
variantString Maybe Text
title Maybe Text
subtitle Maybe Text
keywords Int32
priority = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    CString
groupName' <- Text -> IO CString
textToCString Text
groupName
    CString
schemaId' <- Text -> IO CString
textToCString Text
schemaId
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
maybePath <- case Maybe Text
path of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jPath -> do
            CString
jPath' <- Text -> IO CString
textToCString Text
jPath
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jPath'
    CString
maybeVariantString <- case Maybe Text
variantString of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jVariantString -> do
            CString
jVariantString' <- Text -> IO CString
textToCString Text
jVariantString
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jVariantString'
    CString
maybeTitle <- case Maybe Text
title of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jTitle -> do
            CString
jTitle' <- Text -> IO CString
textToCString Text
jTitle
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTitle'
    CString
maybeSubtitle <- case Maybe Text
subtitle of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jSubtitle -> do
            CString
jSubtitle' <- Text -> IO CString
textToCString Text
jSubtitle
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jSubtitle'
    CString
maybeKeywords <- case Maybe Text
keywords of
        Maybe Text
Nothing -> CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jKeywords -> do
            CString
jKeywords' <- Text -> IO CString
textToCString Text
jKeywords
            CString -> IO CString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jKeywords'
    Word32
result <- Ptr Preferences
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> CString
-> Int32
-> IO Word32
dzl_preferences_add_switch Ptr Preferences
self' CString
pageName' CString
groupName' CString
schemaId' CString
key' CString
maybePath CString
maybeVariantString CString
maybeTitle CString
maybeSubtitle CString
maybeKeywords Int32
priority
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
groupName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
schemaId'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybePath
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeVariantString
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTitle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSubtitle
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeKeywords
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data PreferencesAddSwitchMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> T.Text -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Int32 -> m Word32), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesAddSwitchMethodInfo a signature where
    overloadedMethod = preferencesAddSwitch

instance O.OverloadedMethodInfo PreferencesAddSwitchMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesAddSwitch",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesAddSwitch"
        })


#endif

-- method Preferences::get_widget
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gtk" , name = "Widget" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_get_widget" dzl_preferences_get_widget :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    Word32 ->                               -- widget_id : TBasicType TUInt
    IO (Ptr Gtk.Widget.Widget)

-- | /No description available in the introspection data./
preferencesGetWidget ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> Word32
    -> m (Maybe Gtk.Widget.Widget)
    -- ^ __Returns:__ A t'GI.Gtk.Objects.Widget.Widget' or 'P.Nothing'.
preferencesGetWidget :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a -> Word32 -> m (Maybe Widget)
preferencesGetWidget a
self Word32
widgetId = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Widget
result <- Ptr Preferences -> Word32 -> IO (Ptr Widget)
dzl_preferences_get_widget Ptr Preferences
self' Word32
widgetId
    Maybe Widget
maybeResult <- Ptr Widget -> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Widget
result ((Ptr Widget -> IO Widget) -> IO (Maybe Widget))
-> (Ptr Widget -> IO Widget) -> IO (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr Widget
result' -> do
        Widget
result'' <- ((ManagedPtr Widget -> Widget) -> Ptr Widget -> IO Widget
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Widget -> Widget
Gtk.Widget.Widget) Ptr Widget
result'
        Widget -> IO Widget
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Widget
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Widget -> IO (Maybe Widget)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
maybeResult

#if defined(ENABLE_OVERLOADING)
data PreferencesGetWidgetMethodInfo
instance (signature ~ (Word32 -> m (Maybe Gtk.Widget.Widget)), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesGetWidgetMethodInfo a signature where
    overloadedMethod = preferencesGetWidget

instance O.OverloadedMethodInfo PreferencesGetWidgetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesGetWidget",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesGetWidget"
        })


#endif

-- method Preferences::remove_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "widget_id"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_remove_id" dzl_preferences_remove_id :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    Word32 ->                               -- widget_id : TBasicType TUInt
    IO CInt

-- | /No description available in the introspection data./
preferencesRemoveId ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> Word32
    -> m Bool
preferencesRemoveId :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a -> Word32 -> m Bool
preferencesRemoveId a
self Word32
widgetId = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Preferences -> Word32 -> IO CInt
dzl_preferences_remove_id Ptr Preferences
self' Word32
widgetId
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data PreferencesRemoveIdMethodInfo
instance (signature ~ (Word32 -> m Bool), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesRemoveIdMethodInfo a signature where
    overloadedMethod = preferencesRemoveId

instance O.OverloadedMethodInfo PreferencesRemoveIdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesRemoveId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesRemoveId"
        })


#endif

-- method Preferences::set_page
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Preferences" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "page_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "map"
--           , argType = TGHash (TBasicType TPtr) (TBasicType TPtr)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_preferences_set_page" dzl_preferences_set_page :: 
    Ptr Preferences ->                      -- self : TInterface (Name {namespace = "Dazzle", name = "Preferences"})
    CString ->                              -- page_name : TBasicType TUTF8
    Ptr (GHashTable (Ptr ()) (Ptr ())) ->   -- map : TGHash (TBasicType TPtr) (TBasicType TPtr)
    IO ()

-- | /No description available in the introspection data./
preferencesSetPage ::
    (B.CallStack.HasCallStack, MonadIO m, IsPreferences a) =>
    a
    -> T.Text
    -> Map.Map (Ptr ()) (Ptr ())
    -> m ()
preferencesSetPage :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPreferences a) =>
a -> Text -> Map (Ptr ()) (Ptr ()) -> m ()
preferencesSetPage a
self Text
pageName Map (Ptr ()) (Ptr ())
map_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Preferences
self' <- a -> IO (Ptr Preferences)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
pageName' <- Text -> IO CString
textToCString Text
pageName
    let map_' :: [(Ptr (), Ptr ())]
map_' = Map (Ptr ()) (Ptr ()) -> [(Ptr (), Ptr ())]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Ptr ()) (Ptr ())
map_
    let map_'' :: [(PtrWrapped (Ptr ()), Ptr ())]
map_'' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(Ptr (), Ptr ())] -> [(PtrWrapped (Ptr ()), Ptr ())]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(Ptr (), Ptr ())]
map_'
    let map_''' :: [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
map_''' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(PtrWrapped (Ptr ()), Ptr ())]
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
B.GHT.ptrPackPtr [(PtrWrapped (Ptr ()), Ptr ())]
map_''
    Ptr (GHashTable (Ptr ()) (Ptr ()))
map_'''' <- GHashFunc (Ptr ())
-> GEqualFunc (Ptr ())
-> Maybe (GDestroyNotify (Ptr ()))
-> Maybe (GDestroyNotify (Ptr ()))
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc (Ptr ())
forall a. GHashFunc (Ptr a)
gDirectHash GEqualFunc (Ptr ())
forall a. GEqualFunc (Ptr a)
gDirectEqual Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
map_'''
    Ptr Preferences
-> CString -> Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
dzl_preferences_set_page Ptr Preferences
self' CString
pageName' Ptr (GHashTable (Ptr ()) (Ptr ()))
map_''''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
pageName'
    Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
map_''''
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data PreferencesSetPageMethodInfo
instance (signature ~ (T.Text -> Map.Map (Ptr ()) (Ptr ()) -> m ()), MonadIO m, IsPreferences a) => O.OverloadedMethod PreferencesSetPageMethodInfo a signature where
    overloadedMethod = preferencesSetPage

instance O.OverloadedMethodInfo PreferencesSetPageMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Interfaces.Preferences.preferencesSetPage",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Interfaces-Preferences.html#v:preferencesSetPage"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Preferences = PreferencesSignalList
type PreferencesSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif