{-# 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.Objects.BoxTheatric
    ( 

-- * Exported types
    BoxTheatric(..)                         ,
    IsBoxTheatric                           ,
    toBoxTheatric                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [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"), [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").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveBoxTheatricMethod                ,
#endif



 -- * Properties


-- ** alpha #attr:alpha#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricAlphaPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricAlpha                        ,
#endif
    constructBoxTheatricAlpha               ,
    getBoxTheatricAlpha                     ,
    setBoxTheatricAlpha                     ,


-- ** background #attr:background#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricBackgroundPropertyInfo       ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricBackground                   ,
#endif
    clearBoxTheatricBackground              ,
    constructBoxTheatricBackground          ,
    getBoxTheatricBackground                ,
    setBoxTheatricBackground                ,


-- ** height #attr:height#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricHeightPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricHeight                       ,
#endif
    constructBoxTheatricHeight              ,
    getBoxTheatricHeight                    ,
    setBoxTheatricHeight                    ,


-- ** icon #attr:icon#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricIconPropertyInfo             ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricIcon                         ,
#endif
    clearBoxTheatricIcon                    ,
    constructBoxTheatricIcon                ,
    getBoxTheatricIcon                      ,
    setBoxTheatricIcon                      ,


-- ** surface #attr:surface#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricSurfacePropertyInfo          ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricSurface                      ,
#endif
    constructBoxTheatricSurface             ,


-- ** target #attr:target#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricTargetPropertyInfo           ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricTarget                       ,
#endif
    constructBoxTheatricTarget              ,
    getBoxTheatricTarget                    ,


-- ** width #attr:width#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricWidthPropertyInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricWidth                        ,
#endif
    constructBoxTheatricWidth               ,
    getBoxTheatricWidth                     ,
    setBoxTheatricWidth                     ,


-- ** x #attr:x#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricXPropertyInfo                ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricX                            ,
#endif
    constructBoxTheatricX                   ,
    getBoxTheatricX                         ,
    setBoxTheatricX                         ,


-- ** y #attr:y#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    BoxTheatricYPropertyInfo                ,
#endif
#if defined(ENABLE_OVERLOADING)
    boxTheatricY                            ,
#endif
    constructBoxTheatricY                   ,
    getBoxTheatricY                         ,
    setBoxTheatricY                         ,




    ) 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.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gtk.Objects.Widget as Gtk.Widget

#endif

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

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

foreign import ccall "dzl_box_theatric_get_type"
    c_dzl_box_theatric_get_type :: IO B.Types.GType

instance B.Types.TypedObject BoxTheatric where
    glibType :: IO GType
glibType = IO GType
c_dzl_box_theatric_get_type

instance B.Types.GObject BoxTheatric

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

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

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

-- | Convert 'BoxTheatric' 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 BoxTheatric) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_box_theatric_get_type
    gvalueSet_ :: Ptr GValue -> Maybe BoxTheatric -> IO ()
gvalueSet_ Ptr GValue
gv Maybe BoxTheatric
P.Nothing = Ptr GValue -> Ptr BoxTheatric -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr BoxTheatric
forall a. Ptr a
FP.nullPtr :: FP.Ptr BoxTheatric)
    gvalueSet_ Ptr GValue
gv (P.Just BoxTheatric
obj) = BoxTheatric -> (Ptr BoxTheatric -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BoxTheatric
obj (Ptr GValue -> Ptr BoxTheatric -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe BoxTheatric)
gvalueGet_ Ptr GValue
gv = do
        Ptr BoxTheatric
ptr <- Ptr GValue -> IO (Ptr BoxTheatric)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr BoxTheatric)
        if Ptr BoxTheatric
ptr Ptr BoxTheatric -> Ptr BoxTheatric -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr BoxTheatric
forall a. Ptr a
FP.nullPtr
        then BoxTheatric -> Maybe BoxTheatric
forall a. a -> Maybe a
P.Just (BoxTheatric -> Maybe BoxTheatric)
-> IO BoxTheatric -> IO (Maybe BoxTheatric)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr BoxTheatric -> BoxTheatric)
-> Ptr BoxTheatric -> IO BoxTheatric
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr BoxTheatric -> BoxTheatric
BoxTheatric Ptr BoxTheatric
ptr
        else Maybe BoxTheatric -> IO (Maybe BoxTheatric)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe BoxTheatric
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveBoxTheatricMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveBoxTheatricMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBoxTheatricMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBoxTheatricMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBoxTheatricMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBoxTheatricMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBoxTheatricMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBoxTheatricMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBoxTheatricMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBoxTheatricMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBoxTheatricMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBoxTheatricMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBoxTheatricMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBoxTheatricMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBoxTheatricMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBoxTheatricMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBoxTheatricMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBoxTheatricMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBoxTheatricMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBoxTheatricMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBoxTheatricMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBoxTheatricMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBoxTheatricMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBoxTheatricMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveBoxTheatricMethod t BoxTheatric, O.OverloadedMethod info BoxTheatric p) => OL.IsLabel t (BoxTheatric -> 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 ~ ResolveBoxTheatricMethod t BoxTheatric, O.OverloadedMethod info BoxTheatric p, R.HasField t BoxTheatric p) => R.HasField t BoxTheatric p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- VVV Prop "alpha"
   -- Type: TBasicType TDouble
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@alpha@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' boxTheatric #alpha
-- @
getBoxTheatricAlpha :: (MonadIO m, IsBoxTheatric o) => o -> m Double
getBoxTheatricAlpha :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> m Double
getBoxTheatricAlpha o
obj = IO Double -> m Double
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Double -> m Double) -> IO Double -> m Double
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Double
forall a. GObject a => a -> String -> IO Double
B.Properties.getObjectPropertyDouble o
obj String
"alpha"

-- | Set the value of the “@alpha@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' boxTheatric [ #alpha 'Data.GI.Base.Attributes.:=' value ]
-- @
setBoxTheatricAlpha :: (MonadIO m, IsBoxTheatric o) => o -> Double -> m ()
setBoxTheatricAlpha :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> Double -> m ()
setBoxTheatricAlpha o
obj Double
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Double -> IO ()
forall a. GObject a => a -> String -> Double -> IO ()
B.Properties.setObjectPropertyDouble o
obj String
"alpha" Double
val

-- | Construct a `GValueConstruct` with valid value for the “@alpha@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricAlpha :: (IsBoxTheatric o, MIO.MonadIO m) => Double -> m (GValueConstruct o)
constructBoxTheatricAlpha :: forall o (m :: * -> *).
(IsBoxTheatric o, MonadIO m) =>
Double -> m (GValueConstruct o)
constructBoxTheatricAlpha Double
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Double -> IO (GValueConstruct o)
forall o. String -> Double -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyDouble String
"alpha" Double
val

#if defined(ENABLE_OVERLOADING)
data BoxTheatricAlphaPropertyInfo
instance AttrInfo BoxTheatricAlphaPropertyInfo where
    type AttrAllowedOps BoxTheatricAlphaPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BoxTheatricAlphaPropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricAlphaPropertyInfo = (~) Double
    type AttrTransferTypeConstraint BoxTheatricAlphaPropertyInfo = (~) Double
    type AttrTransferType BoxTheatricAlphaPropertyInfo = Double
    type AttrGetType BoxTheatricAlphaPropertyInfo = Double
    type AttrLabel BoxTheatricAlphaPropertyInfo = "alpha"
    type AttrOrigin BoxTheatricAlphaPropertyInfo = BoxTheatric
    attrGet = getBoxTheatricAlpha
    attrSet = setBoxTheatricAlpha
    attrTransfer _ v = do
        return v
    attrConstruct = constructBoxTheatricAlpha
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.alpha"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:alpha"
        })
#endif

-- VVV Prop "background"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@background@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' boxTheatric #background
-- @
getBoxTheatricBackground :: (MonadIO m, IsBoxTheatric o) => o -> m (Maybe T.Text)
getBoxTheatricBackground :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> m (Maybe Text)
getBoxTheatricBackground o
obj = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"background"

-- | Set the value of the “@background@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' boxTheatric [ #background 'Data.GI.Base.Attributes.:=' value ]
-- @
setBoxTheatricBackground :: (MonadIO m, IsBoxTheatric o) => o -> T.Text -> m ()
setBoxTheatricBackground :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> Text -> m ()
setBoxTheatricBackground o
obj Text
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"background" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@background@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricBackground :: (IsBoxTheatric o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructBoxTheatricBackground :: forall o (m :: * -> *).
(IsBoxTheatric o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructBoxTheatricBackground Text
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"background" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@background@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #background
-- @
clearBoxTheatricBackground :: (MonadIO m, IsBoxTheatric o) => o -> m ()
clearBoxTheatricBackground :: forall (m :: * -> *) o. (MonadIO m, IsBoxTheatric o) => o -> m ()
clearBoxTheatricBackground o
obj = 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
$ o -> String -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"background" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data BoxTheatricBackgroundPropertyInfo
instance AttrInfo BoxTheatricBackgroundPropertyInfo where
    type AttrAllowedOps BoxTheatricBackgroundPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint BoxTheatricBackgroundPropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricBackgroundPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint BoxTheatricBackgroundPropertyInfo = (~) T.Text
    type AttrTransferType BoxTheatricBackgroundPropertyInfo = T.Text
    type AttrGetType BoxTheatricBackgroundPropertyInfo = (Maybe T.Text)
    type AttrLabel BoxTheatricBackgroundPropertyInfo = "background"
    type AttrOrigin BoxTheatricBackgroundPropertyInfo = BoxTheatric
    attrGet = getBoxTheatricBackground
    attrSet = setBoxTheatricBackground
    attrTransfer _ v = do
        return v
    attrConstruct = constructBoxTheatricBackground
    attrClear = clearBoxTheatricBackground
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.background"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:background"
        })
#endif

-- VVV Prop "height"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' boxTheatric #height
-- @
getBoxTheatricHeight :: (MonadIO m, IsBoxTheatric o) => o -> m Int32
getBoxTheatricHeight :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> m Int32
getBoxTheatricHeight o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"height"

-- | Set the value of the “@height@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' boxTheatric [ #height 'Data.GI.Base.Attributes.:=' value ]
-- @
setBoxTheatricHeight :: (MonadIO m, IsBoxTheatric o) => o -> Int32 -> m ()
setBoxTheatricHeight :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> Int32 -> m ()
setBoxTheatricHeight o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"height" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@height@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricHeight :: (IsBoxTheatric o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructBoxTheatricHeight :: forall o (m :: * -> *).
(IsBoxTheatric o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructBoxTheatricHeight Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"height" Int32
val

#if defined(ENABLE_OVERLOADING)
data BoxTheatricHeightPropertyInfo
instance AttrInfo BoxTheatricHeightPropertyInfo where
    type AttrAllowedOps BoxTheatricHeightPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BoxTheatricHeightPropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricHeightPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint BoxTheatricHeightPropertyInfo = (~) Int32
    type AttrTransferType BoxTheatricHeightPropertyInfo = Int32
    type AttrGetType BoxTheatricHeightPropertyInfo = Int32
    type AttrLabel BoxTheatricHeightPropertyInfo = "height"
    type AttrOrigin BoxTheatricHeightPropertyInfo = BoxTheatric
    attrGet = getBoxTheatricHeight
    attrSet = setBoxTheatricHeight
    attrTransfer _ v = do
        return v
    attrConstruct = constructBoxTheatricHeight
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.height"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:height"
        })
#endif

-- VVV Prop "icon"
   -- Type: TInterface (Name {namespace = "Gio", name = "Icon"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' boxTheatric #icon
-- @
getBoxTheatricIcon :: (MonadIO m, IsBoxTheatric o) => o -> m (Maybe Gio.Icon.Icon)
getBoxTheatricIcon :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> m (Maybe Icon)
getBoxTheatricIcon o
obj = IO (Maybe Icon) -> m (Maybe Icon)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Icon) -> m (Maybe Icon))
-> IO (Maybe Icon) -> m (Maybe Icon)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Icon -> Icon) -> IO (Maybe Icon)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"icon" ManagedPtr Icon -> Icon
Gio.Icon.Icon

-- | Set the value of the “@icon@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' boxTheatric [ #icon 'Data.GI.Base.Attributes.:=' value ]
-- @
setBoxTheatricIcon :: (MonadIO m, IsBoxTheatric o, Gio.Icon.IsIcon a) => o -> a -> m ()
setBoxTheatricIcon :: forall (m :: * -> *) o a.
(MonadIO m, IsBoxTheatric o, IsIcon a) =>
o -> a -> m ()
setBoxTheatricIcon o
obj a
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Maybe a -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"icon" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

-- | Construct a `GValueConstruct` with valid value for the “@icon@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricIcon :: (IsBoxTheatric o, MIO.MonadIO m, Gio.Icon.IsIcon a) => a -> m (GValueConstruct o)
constructBoxTheatricIcon :: forall o (m :: * -> *) a.
(IsBoxTheatric o, MonadIO m, IsIcon a) =>
a -> m (GValueConstruct o)
constructBoxTheatricIcon a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"icon" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

-- | Set the value of the “@icon@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #icon
-- @
clearBoxTheatricIcon :: (MonadIO m, IsBoxTheatric o) => o -> m ()
clearBoxTheatricIcon :: forall (m :: * -> *) o. (MonadIO m, IsBoxTheatric o) => o -> m ()
clearBoxTheatricIcon o
obj = 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
$ o -> String -> Maybe Icon -> IO ()
forall a b.
(GObject a, GObject b) =>
a -> String -> Maybe b -> IO ()
B.Properties.setObjectPropertyObject o
obj String
"icon" (Maybe Icon
forall a. Maybe a
Nothing :: Maybe Gio.Icon.Icon)

#if defined(ENABLE_OVERLOADING)
data BoxTheatricIconPropertyInfo
instance AttrInfo BoxTheatricIconPropertyInfo where
    type AttrAllowedOps BoxTheatricIconPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint BoxTheatricIconPropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferTypeConstraint BoxTheatricIconPropertyInfo = Gio.Icon.IsIcon
    type AttrTransferType BoxTheatricIconPropertyInfo = Gio.Icon.Icon
    type AttrGetType BoxTheatricIconPropertyInfo = (Maybe Gio.Icon.Icon)
    type AttrLabel BoxTheatricIconPropertyInfo = "icon"
    type AttrOrigin BoxTheatricIconPropertyInfo = BoxTheatric
    attrGet = getBoxTheatricIcon
    attrSet = setBoxTheatricIcon
    attrTransfer _ v = do
        unsafeCastTo Gio.Icon.Icon v
    attrConstruct = constructBoxTheatricIcon
    attrClear = clearBoxTheatricIcon
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.icon"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:icon"
        })
#endif

-- VVV Prop "surface"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Construct a `GValueConstruct` with valid value for the “@surface@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricSurface :: (IsBoxTheatric o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructBoxTheatricSurface :: forall o (m :: * -> *).
(IsBoxTheatric o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructBoxTheatricSurface Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"surface" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data BoxTheatricSurfacePropertyInfo
instance AttrInfo BoxTheatricSurfacePropertyInfo where
    type AttrAllowedOps BoxTheatricSurfacePropertyInfo = '[ 'AttrConstruct]
    type AttrBaseTypeConstraint BoxTheatricSurfacePropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricSurfacePropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint BoxTheatricSurfacePropertyInfo = (~) (Ptr ())
    type AttrTransferType BoxTheatricSurfacePropertyInfo = Ptr ()
    type AttrGetType BoxTheatricSurfacePropertyInfo = ()
    type AttrLabel BoxTheatricSurfacePropertyInfo = "surface"
    type AttrOrigin BoxTheatricSurfacePropertyInfo = BoxTheatric
    attrGet = undefined
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructBoxTheatricSurface
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.surface"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:surface"
        })
#endif

-- VVV Prop "target"
   -- Type: TInterface (Name {namespace = "Gtk", name = "Widget"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@target@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' boxTheatric #target
-- @
getBoxTheatricTarget :: (MonadIO m, IsBoxTheatric o) => o -> m (Maybe Gtk.Widget.Widget)
getBoxTheatricTarget :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> m (Maybe Widget)
getBoxTheatricTarget o
obj = IO (Maybe Widget) -> m (Maybe Widget)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe Widget) -> m (Maybe Widget))
-> IO (Maybe Widget) -> m (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr Widget -> Widget) -> IO (Maybe Widget)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"target" ManagedPtr Widget -> Widget
Gtk.Widget.Widget

-- | Construct a `GValueConstruct` with valid value for the “@target@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricTarget :: (IsBoxTheatric o, MIO.MonadIO m, Gtk.Widget.IsWidget a) => a -> m (GValueConstruct o)
constructBoxTheatricTarget :: forall o (m :: * -> *) a.
(IsBoxTheatric o, MonadIO m, IsWidget a) =>
a -> m (GValueConstruct o)
constructBoxTheatricTarget a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"target" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data BoxTheatricTargetPropertyInfo
instance AttrInfo BoxTheatricTargetPropertyInfo where
    type AttrAllowedOps BoxTheatricTargetPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint BoxTheatricTargetPropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricTargetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferTypeConstraint BoxTheatricTargetPropertyInfo = Gtk.Widget.IsWidget
    type AttrTransferType BoxTheatricTargetPropertyInfo = Gtk.Widget.Widget
    type AttrGetType BoxTheatricTargetPropertyInfo = (Maybe Gtk.Widget.Widget)
    type AttrLabel BoxTheatricTargetPropertyInfo = "target"
    type AttrOrigin BoxTheatricTargetPropertyInfo = BoxTheatric
    attrGet = getBoxTheatricTarget
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gtk.Widget.Widget v
    attrConstruct = constructBoxTheatricTarget
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.target"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:target"
        })
#endif

-- VVV Prop "width"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' boxTheatric #width
-- @
getBoxTheatricWidth :: (MonadIO m, IsBoxTheatric o) => o -> m Int32
getBoxTheatricWidth :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> m Int32
getBoxTheatricWidth o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"width"

-- | Set the value of the “@width@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' boxTheatric [ #width 'Data.GI.Base.Attributes.:=' value ]
-- @
setBoxTheatricWidth :: (MonadIO m, IsBoxTheatric o) => o -> Int32 -> m ()
setBoxTheatricWidth :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> Int32 -> m ()
setBoxTheatricWidth o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"width" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@width@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricWidth :: (IsBoxTheatric o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructBoxTheatricWidth :: forall o (m :: * -> *).
(IsBoxTheatric o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructBoxTheatricWidth Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"width" Int32
val

#if defined(ENABLE_OVERLOADING)
data BoxTheatricWidthPropertyInfo
instance AttrInfo BoxTheatricWidthPropertyInfo where
    type AttrAllowedOps BoxTheatricWidthPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BoxTheatricWidthPropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricWidthPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint BoxTheatricWidthPropertyInfo = (~) Int32
    type AttrTransferType BoxTheatricWidthPropertyInfo = Int32
    type AttrGetType BoxTheatricWidthPropertyInfo = Int32
    type AttrLabel BoxTheatricWidthPropertyInfo = "width"
    type AttrOrigin BoxTheatricWidthPropertyInfo = BoxTheatric
    attrGet = getBoxTheatricWidth
    attrSet = setBoxTheatricWidth
    attrTransfer _ v = do
        return v
    attrConstruct = constructBoxTheatricWidth
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.width"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:width"
        })
#endif

-- VVV Prop "x"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@x@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' boxTheatric #x
-- @
getBoxTheatricX :: (MonadIO m, IsBoxTheatric o) => o -> m Int32
getBoxTheatricX :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> m Int32
getBoxTheatricX o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"x"

-- | Set the value of the “@x@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' boxTheatric [ #x 'Data.GI.Base.Attributes.:=' value ]
-- @
setBoxTheatricX :: (MonadIO m, IsBoxTheatric o) => o -> Int32 -> m ()
setBoxTheatricX :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> Int32 -> m ()
setBoxTheatricX o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"x" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@x@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricX :: (IsBoxTheatric o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructBoxTheatricX :: forall o (m :: * -> *).
(IsBoxTheatric o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructBoxTheatricX Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"x" Int32
val

#if defined(ENABLE_OVERLOADING)
data BoxTheatricXPropertyInfo
instance AttrInfo BoxTheatricXPropertyInfo where
    type AttrAllowedOps BoxTheatricXPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BoxTheatricXPropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricXPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint BoxTheatricXPropertyInfo = (~) Int32
    type AttrTransferType BoxTheatricXPropertyInfo = Int32
    type AttrGetType BoxTheatricXPropertyInfo = Int32
    type AttrLabel BoxTheatricXPropertyInfo = "x"
    type AttrOrigin BoxTheatricXPropertyInfo = BoxTheatric
    attrGet = getBoxTheatricX
    attrSet = setBoxTheatricX
    attrTransfer _ v = do
        return v
    attrConstruct = constructBoxTheatricX
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.x"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:x"
        })
#endif

-- VVV Prop "y"
   -- Type: TBasicType TInt
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@y@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' boxTheatric #y
-- @
getBoxTheatricY :: (MonadIO m, IsBoxTheatric o) => o -> m Int32
getBoxTheatricY :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> m Int32
getBoxTheatricY o
obj = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Int32
forall a. GObject a => a -> String -> IO Int32
B.Properties.getObjectPropertyInt32 o
obj String
"y"

-- | Set the value of the “@y@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' boxTheatric [ #y 'Data.GI.Base.Attributes.:=' value ]
-- @
setBoxTheatricY :: (MonadIO m, IsBoxTheatric o) => o -> Int32 -> m ()
setBoxTheatricY :: forall (m :: * -> *) o.
(MonadIO m, IsBoxTheatric o) =>
o -> Int32 -> m ()
setBoxTheatricY o
obj Int32
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Int32 -> IO ()
forall a. GObject a => a -> String -> Int32 -> IO ()
B.Properties.setObjectPropertyInt32 o
obj String
"y" Int32
val

-- | Construct a `GValueConstruct` with valid value for the “@y@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructBoxTheatricY :: (IsBoxTheatric o, MIO.MonadIO m) => Int32 -> m (GValueConstruct o)
constructBoxTheatricY :: forall o (m :: * -> *).
(IsBoxTheatric o, MonadIO m) =>
Int32 -> m (GValueConstruct o)
constructBoxTheatricY Int32
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Int32 -> IO (GValueConstruct o)
forall o. String -> Int32 -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyInt32 String
"y" Int32
val

#if defined(ENABLE_OVERLOADING)
data BoxTheatricYPropertyInfo
instance AttrInfo BoxTheatricYPropertyInfo where
    type AttrAllowedOps BoxTheatricYPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint BoxTheatricYPropertyInfo = IsBoxTheatric
    type AttrSetTypeConstraint BoxTheatricYPropertyInfo = (~) Int32
    type AttrTransferTypeConstraint BoxTheatricYPropertyInfo = (~) Int32
    type AttrTransferType BoxTheatricYPropertyInfo = Int32
    type AttrGetType BoxTheatricYPropertyInfo = Int32
    type AttrLabel BoxTheatricYPropertyInfo = "y"
    type AttrOrigin BoxTheatricYPropertyInfo = BoxTheatric
    attrGet = getBoxTheatricY
    attrSet = setBoxTheatricY
    attrTransfer _ v = do
        return v
    attrConstruct = constructBoxTheatricY
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.BoxTheatric.y"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-BoxTheatric.html#g:attr:y"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList BoxTheatric
type instance O.AttributeList BoxTheatric = BoxTheatricAttributeList
type BoxTheatricAttributeList = ('[ '("alpha", BoxTheatricAlphaPropertyInfo), '("background", BoxTheatricBackgroundPropertyInfo), '("height", BoxTheatricHeightPropertyInfo), '("icon", BoxTheatricIconPropertyInfo), '("surface", BoxTheatricSurfacePropertyInfo), '("target", BoxTheatricTargetPropertyInfo), '("width", BoxTheatricWidthPropertyInfo), '("x", BoxTheatricXPropertyInfo), '("y", BoxTheatricYPropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
boxTheatricAlpha :: AttrLabelProxy "alpha"
boxTheatricAlpha = AttrLabelProxy

boxTheatricBackground :: AttrLabelProxy "background"
boxTheatricBackground = AttrLabelProxy

boxTheatricHeight :: AttrLabelProxy "height"
boxTheatricHeight = AttrLabelProxy

boxTheatricIcon :: AttrLabelProxy "icon"
boxTheatricIcon = AttrLabelProxy

boxTheatricSurface :: AttrLabelProxy "surface"
boxTheatricSurface = AttrLabelProxy

boxTheatricTarget :: AttrLabelProxy "target"
boxTheatricTarget = AttrLabelProxy

boxTheatricWidth :: AttrLabelProxy "width"
boxTheatricWidth = AttrLabelProxy

boxTheatricX :: AttrLabelProxy "x"
boxTheatricX = AttrLabelProxy

boxTheatricY :: AttrLabelProxy "y"
boxTheatricY = AttrLabelProxy

#endif

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

#endif