{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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.GtkSource.Objects.Style
    ( 

-- * Exported types
    Style(..)                               ,
    IsStyle                                 ,
    toStyle                                 ,
    noStyle                                 ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveStyleMethod                      ,
#endif


-- ** apply #method:apply#

#if defined(ENABLE_OVERLOADING)
    StyleApplyMethodInfo                    ,
#endif
    styleApply                              ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    StyleCopyMethodInfo                     ,
#endif
    styleCopy                               ,




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

#if defined(ENABLE_OVERLOADING)
    StyleBackgroundPropertyInfo             ,
#endif
    constructStyleBackground                ,
    getStyleBackground                      ,
#if defined(ENABLE_OVERLOADING)
    styleBackground                         ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleBackgroundSetPropertyInfo          ,
#endif
    constructStyleBackgroundSet             ,
    getStyleBackgroundSet                   ,
#if defined(ENABLE_OVERLOADING)
    styleBackgroundSet                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleBoldPropertyInfo                   ,
#endif
    constructStyleBold                      ,
    getStyleBold                            ,
#if defined(ENABLE_OVERLOADING)
    styleBold                               ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleBoldSetPropertyInfo                ,
#endif
    constructStyleBoldSet                   ,
    getStyleBoldSet                         ,
#if defined(ENABLE_OVERLOADING)
    styleBoldSet                            ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleForegroundPropertyInfo             ,
#endif
    constructStyleForeground                ,
    getStyleForeground                      ,
#if defined(ENABLE_OVERLOADING)
    styleForeground                         ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleForegroundSetPropertyInfo          ,
#endif
    constructStyleForegroundSet             ,
    getStyleForegroundSet                   ,
#if defined(ENABLE_OVERLOADING)
    styleForegroundSet                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleItalicPropertyInfo                 ,
#endif
    constructStyleItalic                    ,
    getStyleItalic                          ,
#if defined(ENABLE_OVERLOADING)
    styleItalic                             ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleItalicSetPropertyInfo              ,
#endif
    constructStyleItalicSet                 ,
    getStyleItalicSet                       ,
#if defined(ENABLE_OVERLOADING)
    styleItalicSet                          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleLineBackgroundPropertyInfo         ,
#endif
    constructStyleLineBackground            ,
    getStyleLineBackground                  ,
#if defined(ENABLE_OVERLOADING)
    styleLineBackground                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleLineBackgroundSetPropertyInfo      ,
#endif
    constructStyleLineBackgroundSet         ,
    getStyleLineBackgroundSet               ,
#if defined(ENABLE_OVERLOADING)
    styleLineBackgroundSet                  ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StylePangoUnderlinePropertyInfo         ,
#endif
    constructStylePangoUnderline            ,
    getStylePangoUnderline                  ,
#if defined(ENABLE_OVERLOADING)
    stylePangoUnderline                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleScalePropertyInfo                  ,
#endif
    constructStyleScale                     ,
    getStyleScale                           ,
#if defined(ENABLE_OVERLOADING)
    styleScale                              ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleScaleSetPropertyInfo               ,
#endif
    constructStyleScaleSet                  ,
    getStyleScaleSet                        ,
#if defined(ENABLE_OVERLOADING)
    styleScaleSet                           ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleStrikethroughPropertyInfo          ,
#endif
    constructStyleStrikethrough             ,
    getStyleStrikethrough                   ,
#if defined(ENABLE_OVERLOADING)
    styleStrikethrough                      ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleStrikethroughSetPropertyInfo       ,
#endif
    constructStyleStrikethroughSet          ,
    getStyleStrikethroughSet                ,
#if defined(ENABLE_OVERLOADING)
    styleStrikethroughSet                   ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleUnderlinePropertyInfo              ,
#endif
    constructStyleUnderline                 ,
    getStyleUnderline                       ,
#if defined(ENABLE_OVERLOADING)
    styleUnderline                          ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleUnderlineColorPropertyInfo         ,
#endif
    constructStyleUnderlineColor            ,
    getStyleUnderlineColor                  ,
#if defined(ENABLE_OVERLOADING)
    styleUnderlineColor                     ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleUnderlineColorSetPropertyInfo      ,
#endif
    constructStyleUnderlineColorSet         ,
    getStyleUnderlineColorSet               ,
#if defined(ENABLE_OVERLOADING)
    styleUnderlineColorSet                  ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    StyleUnderlineSetPropertyInfo           ,
#endif
    constructStyleUnderlineSet              ,
    getStyleUnderlineSet                    ,
#if defined(ENABLE_OVERLOADING)
    styleUnderlineSet                       ,
#endif




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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 Data.Text as T
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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.TextTag as Gtk.TextTag
import qualified GI.Pango.Enums as Pango.Enums

-- | Memory-managed wrapper type.
newtype Style = Style (ManagedPtr Style)
    deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq)
foreign import ccall "gtk_source_style_get_type"
    c_gtk_source_style_get_type :: IO GType

instance GObject Style where
    gobjectType :: IO GType
gobjectType = IO GType
c_gtk_source_style_get_type
    

-- | Convert 'Style' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Style where
    toGValue :: Style -> IO GValue
toGValue o :: Style
o = do
        GType
gtype <- IO GType
c_gtk_source_style_get_type
        Style -> (Ptr Style -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Style
o (GType -> (GValue -> Ptr Style -> IO ()) -> Ptr Style -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Style -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Style
fromGValue gv :: GValue
gv = do
        Ptr Style
ptr <- GValue -> IO (Ptr Style)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Style)
        (ManagedPtr Style -> Style) -> Ptr Style -> IO Style
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Style -> Style
Style Ptr Style
ptr
        
    

-- | Type class for types which can be safely cast to `Style`, for instance with `toStyle`.
class (GObject o, O.IsDescendantOf Style o) => IsStyle o
instance (GObject o, O.IsDescendantOf Style o) => IsStyle o

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

-- | Cast to `Style`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toStyle :: (MonadIO m, IsStyle o) => o -> m Style
toStyle :: o -> m Style
toStyle = IO Style -> m Style
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Style -> m Style) -> (o -> IO Style) -> o -> m Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Style -> Style) -> o -> IO Style
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Style -> Style
Style

-- | A convenience alias for `Nothing` :: `Maybe` `Style`.
noStyle :: Maybe Style
noStyle :: Maybe Style
noStyle = Maybe Style
forall a. Maybe a
Nothing

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

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

#endif

-- VVV Prop "background"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- 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' style #background
-- @
getStyleBackground :: (MonadIO m, IsStyle o) => o -> m (Maybe T.Text)
getStyleBackground :: o -> m (Maybe Text)
getStyleBackground obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "background"

-- | 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`.
constructStyleBackground :: (IsStyle o) => T.Text -> IO (GValueConstruct o)
constructStyleBackground :: Text -> IO (GValueConstruct o)
constructStyleBackground val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "background" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

#if defined(ENABLE_OVERLOADING)
data StyleBackgroundPropertyInfo
instance AttrInfo StyleBackgroundPropertyInfo where
    type AttrAllowedOps StyleBackgroundPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StyleBackgroundPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleBackgroundPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StyleBackgroundPropertyInfo = (~) T.Text
    type AttrTransferType StyleBackgroundPropertyInfo = T.Text
    type AttrGetType StyleBackgroundPropertyInfo = (Maybe T.Text)
    type AttrLabel StyleBackgroundPropertyInfo = "background"
    type AttrOrigin StyleBackgroundPropertyInfo = Style
    attrGet = getStyleBackground
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleBackground
    attrClear = undefined
#endif

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

-- | Get the value of the “@background-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #backgroundSet
-- @
getStyleBackgroundSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleBackgroundSet :: o -> m Bool
getStyleBackgroundSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "background-set"

-- | Construct a `GValueConstruct` with valid value for the “@background-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleBackgroundSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleBackgroundSet :: Bool -> IO (GValueConstruct o)
constructStyleBackgroundSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "background-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleBackgroundSetPropertyInfo
instance AttrInfo StyleBackgroundSetPropertyInfo where
    type AttrAllowedOps StyleBackgroundSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleBackgroundSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleBackgroundSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleBackgroundSetPropertyInfo = (~) Bool
    type AttrTransferType StyleBackgroundSetPropertyInfo = Bool
    type AttrGetType StyleBackgroundSetPropertyInfo = Bool
    type AttrLabel StyleBackgroundSetPropertyInfo = "background-set"
    type AttrOrigin StyleBackgroundSetPropertyInfo = Style
    attrGet = getStyleBackgroundSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleBackgroundSet
    attrClear = undefined
#endif

-- VVV Prop "bold"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@bold@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #bold
-- @
getStyleBold :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleBold :: o -> m Bool
getStyleBold obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "bold"

-- | Construct a `GValueConstruct` with valid value for the “@bold@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleBold :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleBold :: Bool -> IO (GValueConstruct o)
constructStyleBold val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "bold" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleBoldPropertyInfo
instance AttrInfo StyleBoldPropertyInfo where
    type AttrAllowedOps StyleBoldPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleBoldPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleBoldPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleBoldPropertyInfo = (~) Bool
    type AttrTransferType StyleBoldPropertyInfo = Bool
    type AttrGetType StyleBoldPropertyInfo = Bool
    type AttrLabel StyleBoldPropertyInfo = "bold"
    type AttrOrigin StyleBoldPropertyInfo = Style
    attrGet = getStyleBold
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleBold
    attrClear = undefined
#endif

-- VVV Prop "bold-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@bold-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #boldSet
-- @
getStyleBoldSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleBoldSet :: o -> m Bool
getStyleBoldSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "bold-set"

-- | Construct a `GValueConstruct` with valid value for the “@bold-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleBoldSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleBoldSet :: Bool -> IO (GValueConstruct o)
constructStyleBoldSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "bold-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleBoldSetPropertyInfo
instance AttrInfo StyleBoldSetPropertyInfo where
    type AttrAllowedOps StyleBoldSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleBoldSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleBoldSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleBoldSetPropertyInfo = (~) Bool
    type AttrTransferType StyleBoldSetPropertyInfo = Bool
    type AttrGetType StyleBoldSetPropertyInfo = Bool
    type AttrLabel StyleBoldSetPropertyInfo = "bold-set"
    type AttrOrigin StyleBoldSetPropertyInfo = Style
    attrGet = getStyleBoldSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleBoldSet
    attrClear = undefined
#endif

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

-- | Get the value of the “@foreground@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #foreground
-- @
getStyleForeground :: (MonadIO m, IsStyle o) => o -> m (Maybe T.Text)
getStyleForeground :: o -> m (Maybe Text)
getStyleForeground obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "foreground"

-- | Construct a `GValueConstruct` with valid value for the “@foreground@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleForeground :: (IsStyle o) => T.Text -> IO (GValueConstruct o)
constructStyleForeground :: Text -> IO (GValueConstruct o)
constructStyleForeground val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "foreground" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

#if defined(ENABLE_OVERLOADING)
data StyleForegroundPropertyInfo
instance AttrInfo StyleForegroundPropertyInfo where
    type AttrAllowedOps StyleForegroundPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StyleForegroundPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleForegroundPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StyleForegroundPropertyInfo = (~) T.Text
    type AttrTransferType StyleForegroundPropertyInfo = T.Text
    type AttrGetType StyleForegroundPropertyInfo = (Maybe T.Text)
    type AttrLabel StyleForegroundPropertyInfo = "foreground"
    type AttrOrigin StyleForegroundPropertyInfo = Style
    attrGet = getStyleForeground
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleForeground
    attrClear = undefined
#endif

-- VVV Prop "foreground-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@foreground-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #foregroundSet
-- @
getStyleForegroundSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleForegroundSet :: o -> m Bool
getStyleForegroundSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "foreground-set"

-- | Construct a `GValueConstruct` with valid value for the “@foreground-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleForegroundSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleForegroundSet :: Bool -> IO (GValueConstruct o)
constructStyleForegroundSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "foreground-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleForegroundSetPropertyInfo
instance AttrInfo StyleForegroundSetPropertyInfo where
    type AttrAllowedOps StyleForegroundSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleForegroundSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleForegroundSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleForegroundSetPropertyInfo = (~) Bool
    type AttrTransferType StyleForegroundSetPropertyInfo = Bool
    type AttrGetType StyleForegroundSetPropertyInfo = Bool
    type AttrLabel StyleForegroundSetPropertyInfo = "foreground-set"
    type AttrOrigin StyleForegroundSetPropertyInfo = Style
    attrGet = getStyleForegroundSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleForegroundSet
    attrClear = undefined
#endif

-- VVV Prop "italic"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@italic@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #italic
-- @
getStyleItalic :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleItalic :: o -> m Bool
getStyleItalic obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "italic"

-- | Construct a `GValueConstruct` with valid value for the “@italic@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleItalic :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleItalic :: Bool -> IO (GValueConstruct o)
constructStyleItalic val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "italic" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleItalicPropertyInfo
instance AttrInfo StyleItalicPropertyInfo where
    type AttrAllowedOps StyleItalicPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleItalicPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleItalicPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleItalicPropertyInfo = (~) Bool
    type AttrTransferType StyleItalicPropertyInfo = Bool
    type AttrGetType StyleItalicPropertyInfo = Bool
    type AttrLabel StyleItalicPropertyInfo = "italic"
    type AttrOrigin StyleItalicPropertyInfo = Style
    attrGet = getStyleItalic
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleItalic
    attrClear = undefined
#endif

-- VVV Prop "italic-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@italic-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #italicSet
-- @
getStyleItalicSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleItalicSet :: o -> m Bool
getStyleItalicSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "italic-set"

-- | Construct a `GValueConstruct` with valid value for the “@italic-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleItalicSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleItalicSet :: Bool -> IO (GValueConstruct o)
constructStyleItalicSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "italic-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleItalicSetPropertyInfo
instance AttrInfo StyleItalicSetPropertyInfo where
    type AttrAllowedOps StyleItalicSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleItalicSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleItalicSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleItalicSetPropertyInfo = (~) Bool
    type AttrTransferType StyleItalicSetPropertyInfo = Bool
    type AttrGetType StyleItalicSetPropertyInfo = Bool
    type AttrLabel StyleItalicSetPropertyInfo = "italic-set"
    type AttrOrigin StyleItalicSetPropertyInfo = Style
    attrGet = getStyleItalicSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleItalicSet
    attrClear = undefined
#endif

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

-- | Get the value of the “@line-background@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #lineBackground
-- @
getStyleLineBackground :: (MonadIO m, IsStyle o) => o -> m (Maybe T.Text)
getStyleLineBackground :: o -> m (Maybe Text)
getStyleLineBackground obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "line-background"

-- | Construct a `GValueConstruct` with valid value for the “@line-background@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleLineBackground :: (IsStyle o) => T.Text -> IO (GValueConstruct o)
constructStyleLineBackground :: Text -> IO (GValueConstruct o)
constructStyleLineBackground val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "line-background" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

#if defined(ENABLE_OVERLOADING)
data StyleLineBackgroundPropertyInfo
instance AttrInfo StyleLineBackgroundPropertyInfo where
    type AttrAllowedOps StyleLineBackgroundPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StyleLineBackgroundPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleLineBackgroundPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StyleLineBackgroundPropertyInfo = (~) T.Text
    type AttrTransferType StyleLineBackgroundPropertyInfo = T.Text
    type AttrGetType StyleLineBackgroundPropertyInfo = (Maybe T.Text)
    type AttrLabel StyleLineBackgroundPropertyInfo = "line-background"
    type AttrOrigin StyleLineBackgroundPropertyInfo = Style
    attrGet = getStyleLineBackground
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleLineBackground
    attrClear = undefined
#endif

-- VVV Prop "line-background-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@line-background-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #lineBackgroundSet
-- @
getStyleLineBackgroundSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleLineBackgroundSet :: o -> m Bool
getStyleLineBackgroundSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "line-background-set"

-- | Construct a `GValueConstruct` with valid value for the “@line-background-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleLineBackgroundSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleLineBackgroundSet :: Bool -> IO (GValueConstruct o)
constructStyleLineBackgroundSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "line-background-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleLineBackgroundSetPropertyInfo
instance AttrInfo StyleLineBackgroundSetPropertyInfo where
    type AttrAllowedOps StyleLineBackgroundSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleLineBackgroundSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleLineBackgroundSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleLineBackgroundSetPropertyInfo = (~) Bool
    type AttrTransferType StyleLineBackgroundSetPropertyInfo = Bool
    type AttrGetType StyleLineBackgroundSetPropertyInfo = Bool
    type AttrLabel StyleLineBackgroundSetPropertyInfo = "line-background-set"
    type AttrOrigin StyleLineBackgroundSetPropertyInfo = Style
    attrGet = getStyleLineBackgroundSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleLineBackgroundSet
    attrClear = undefined
#endif

-- VVV Prop "pango-underline"
   -- Type: TInterface (Name {namespace = "Pango", name = "Underline"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@pango-underline@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #pangoUnderline
-- @
getStylePangoUnderline :: (MonadIO m, IsStyle o) => o -> m Pango.Enums.Underline
getStylePangoUnderline :: o -> m Underline
getStylePangoUnderline obj :: o
obj = IO Underline -> m Underline
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Underline -> m Underline) -> IO Underline -> m Underline
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Underline
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj "pango-underline"

-- | Construct a `GValueConstruct` with valid value for the “@pango-underline@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStylePangoUnderline :: (IsStyle o) => Pango.Enums.Underline -> IO (GValueConstruct o)
constructStylePangoUnderline :: Underline -> IO (GValueConstruct o)
constructStylePangoUnderline val :: Underline
val = String -> Underline -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum "pango-underline" Underline
val

#if defined(ENABLE_OVERLOADING)
data StylePangoUnderlinePropertyInfo
instance AttrInfo StylePangoUnderlinePropertyInfo where
    type AttrAllowedOps StylePangoUnderlinePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StylePangoUnderlinePropertyInfo = IsStyle
    type AttrSetTypeConstraint StylePangoUnderlinePropertyInfo = (~) Pango.Enums.Underline
    type AttrTransferTypeConstraint StylePangoUnderlinePropertyInfo = (~) Pango.Enums.Underline
    type AttrTransferType StylePangoUnderlinePropertyInfo = Pango.Enums.Underline
    type AttrGetType StylePangoUnderlinePropertyInfo = Pango.Enums.Underline
    type AttrLabel StylePangoUnderlinePropertyInfo = "pango-underline"
    type AttrOrigin StylePangoUnderlinePropertyInfo = Style
    attrGet = getStylePangoUnderline
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStylePangoUnderline
    attrClear = undefined
#endif

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

-- | Get the value of the “@scale@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #scale
-- @
getStyleScale :: (MonadIO m, IsStyle o) => o -> m (Maybe T.Text)
getStyleScale :: o -> m (Maybe Text)
getStyleScale obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "scale"

-- | Construct a `GValueConstruct` with valid value for the “@scale@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleScale :: (IsStyle o) => T.Text -> IO (GValueConstruct o)
constructStyleScale :: Text -> IO (GValueConstruct o)
constructStyleScale val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "scale" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

#if defined(ENABLE_OVERLOADING)
data StyleScalePropertyInfo
instance AttrInfo StyleScalePropertyInfo where
    type AttrAllowedOps StyleScalePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StyleScalePropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleScalePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StyleScalePropertyInfo = (~) T.Text
    type AttrTransferType StyleScalePropertyInfo = T.Text
    type AttrGetType StyleScalePropertyInfo = (Maybe T.Text)
    type AttrLabel StyleScalePropertyInfo = "scale"
    type AttrOrigin StyleScalePropertyInfo = Style
    attrGet = getStyleScale
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleScale
    attrClear = undefined
#endif

-- VVV Prop "scale-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@scale-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #scaleSet
-- @
getStyleScaleSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleScaleSet :: o -> m Bool
getStyleScaleSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "scale-set"

-- | Construct a `GValueConstruct` with valid value for the “@scale-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleScaleSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleScaleSet :: Bool -> IO (GValueConstruct o)
constructStyleScaleSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "scale-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleScaleSetPropertyInfo
instance AttrInfo StyleScaleSetPropertyInfo where
    type AttrAllowedOps StyleScaleSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleScaleSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleScaleSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleScaleSetPropertyInfo = (~) Bool
    type AttrTransferType StyleScaleSetPropertyInfo = Bool
    type AttrGetType StyleScaleSetPropertyInfo = Bool
    type AttrLabel StyleScaleSetPropertyInfo = "scale-set"
    type AttrOrigin StyleScaleSetPropertyInfo = Style
    attrGet = getStyleScaleSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleScaleSet
    attrClear = undefined
#endif

-- VVV Prop "strikethrough"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@strikethrough@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #strikethrough
-- @
getStyleStrikethrough :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleStrikethrough :: o -> m Bool
getStyleStrikethrough obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "strikethrough"

-- | Construct a `GValueConstruct` with valid value for the “@strikethrough@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleStrikethrough :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleStrikethrough :: Bool -> IO (GValueConstruct o)
constructStyleStrikethrough val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "strikethrough" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleStrikethroughPropertyInfo
instance AttrInfo StyleStrikethroughPropertyInfo where
    type AttrAllowedOps StyleStrikethroughPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleStrikethroughPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleStrikethroughPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleStrikethroughPropertyInfo = (~) Bool
    type AttrTransferType StyleStrikethroughPropertyInfo = Bool
    type AttrGetType StyleStrikethroughPropertyInfo = Bool
    type AttrLabel StyleStrikethroughPropertyInfo = "strikethrough"
    type AttrOrigin StyleStrikethroughPropertyInfo = Style
    attrGet = getStyleStrikethrough
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleStrikethrough
    attrClear = undefined
#endif

-- VVV Prop "strikethrough-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@strikethrough-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #strikethroughSet
-- @
getStyleStrikethroughSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleStrikethroughSet :: o -> m Bool
getStyleStrikethroughSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "strikethrough-set"

-- | Construct a `GValueConstruct` with valid value for the “@strikethrough-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleStrikethroughSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleStrikethroughSet :: Bool -> IO (GValueConstruct o)
constructStyleStrikethroughSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "strikethrough-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleStrikethroughSetPropertyInfo
instance AttrInfo StyleStrikethroughSetPropertyInfo where
    type AttrAllowedOps StyleStrikethroughSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleStrikethroughSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleStrikethroughSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleStrikethroughSetPropertyInfo = (~) Bool
    type AttrTransferType StyleStrikethroughSetPropertyInfo = Bool
    type AttrGetType StyleStrikethroughSetPropertyInfo = Bool
    type AttrLabel StyleStrikethroughSetPropertyInfo = "strikethrough-set"
    type AttrOrigin StyleStrikethroughSetPropertyInfo = Style
    attrGet = getStyleStrikethroughSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleStrikethroughSet
    attrClear = undefined
#endif

-- VVV Prop "underline"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@underline@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #underline
-- @
getStyleUnderline :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleUnderline :: o -> m Bool
getStyleUnderline obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "underline"

-- | Construct a `GValueConstruct` with valid value for the “@underline@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleUnderline :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleUnderline :: Bool -> IO (GValueConstruct o)
constructStyleUnderline val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "underline" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleUnderlinePropertyInfo
instance AttrInfo StyleUnderlinePropertyInfo where
    type AttrAllowedOps StyleUnderlinePropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleUnderlinePropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleUnderlinePropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleUnderlinePropertyInfo = (~) Bool
    type AttrTransferType StyleUnderlinePropertyInfo = Bool
    type AttrGetType StyleUnderlinePropertyInfo = Bool
    type AttrLabel StyleUnderlinePropertyInfo = "underline"
    type AttrOrigin StyleUnderlinePropertyInfo = Style
    attrGet = getStyleUnderline
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleUnderline
    attrClear = undefined
#endif

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

-- | Get the value of the “@underline-color@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #underlineColor
-- @
getStyleUnderlineColor :: (MonadIO m, IsStyle o) => o -> m (Maybe T.Text)
getStyleUnderlineColor :: o -> m (Maybe Text)
getStyleUnderlineColor obj :: o
obj = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
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 "underline-color"

-- | Construct a `GValueConstruct` with valid value for the “@underline-color@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleUnderlineColor :: (IsStyle o) => T.Text -> IO (GValueConstruct o)
constructStyleUnderlineColor :: Text -> IO (GValueConstruct o)
constructStyleUnderlineColor val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "underline-color" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

#if defined(ENABLE_OVERLOADING)
data StyleUnderlineColorPropertyInfo
instance AttrInfo StyleUnderlineColorPropertyInfo where
    type AttrAllowedOps StyleUnderlineColorPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StyleUnderlineColorPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleUnderlineColorPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint StyleUnderlineColorPropertyInfo = (~) T.Text
    type AttrTransferType StyleUnderlineColorPropertyInfo = T.Text
    type AttrGetType StyleUnderlineColorPropertyInfo = (Maybe T.Text)
    type AttrLabel StyleUnderlineColorPropertyInfo = "underline-color"
    type AttrOrigin StyleUnderlineColorPropertyInfo = Style
    attrGet = getStyleUnderlineColor
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleUnderlineColor
    attrClear = undefined
#endif

-- VVV Prop "underline-color-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@underline-color-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #underlineColorSet
-- @
getStyleUnderlineColorSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleUnderlineColorSet :: o -> m Bool
getStyleUnderlineColorSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "underline-color-set"

-- | Construct a `GValueConstruct` with valid value for the “@underline-color-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleUnderlineColorSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleUnderlineColorSet :: Bool -> IO (GValueConstruct o)
constructStyleUnderlineColorSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "underline-color-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleUnderlineColorSetPropertyInfo
instance AttrInfo StyleUnderlineColorSetPropertyInfo where
    type AttrAllowedOps StyleUnderlineColorSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleUnderlineColorSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleUnderlineColorSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleUnderlineColorSetPropertyInfo = (~) Bool
    type AttrTransferType StyleUnderlineColorSetPropertyInfo = Bool
    type AttrGetType StyleUnderlineColorSetPropertyInfo = Bool
    type AttrLabel StyleUnderlineColorSetPropertyInfo = "underline-color-set"
    type AttrOrigin StyleUnderlineColorSetPropertyInfo = Style
    attrGet = getStyleUnderlineColorSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleUnderlineColorSet
    attrClear = undefined
#endif

-- VVV Prop "underline-set"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@underline-set@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' style #underlineSet
-- @
getStyleUnderlineSet :: (MonadIO m, IsStyle o) => o -> m Bool
getStyleUnderlineSet :: o -> m Bool
getStyleUnderlineSet obj :: o
obj = IO Bool -> m Bool
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
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj "underline-set"

-- | Construct a `GValueConstruct` with valid value for the “@underline-set@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleUnderlineSet :: (IsStyle o) => Bool -> IO (GValueConstruct o)
constructStyleUnderlineSet :: Bool -> IO (GValueConstruct o)
constructStyleUnderlineSet val :: Bool
val = String -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool "underline-set" Bool
val

#if defined(ENABLE_OVERLOADING)
data StyleUnderlineSetPropertyInfo
instance AttrInfo StyleUnderlineSetPropertyInfo where
    type AttrAllowedOps StyleUnderlineSetPropertyInfo = '[ 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleUnderlineSetPropertyInfo = IsStyle
    type AttrSetTypeConstraint StyleUnderlineSetPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint StyleUnderlineSetPropertyInfo = (~) Bool
    type AttrTransferType StyleUnderlineSetPropertyInfo = Bool
    type AttrGetType StyleUnderlineSetPropertyInfo = Bool
    type AttrLabel StyleUnderlineSetPropertyInfo = "underline-set"
    type AttrOrigin StyleUnderlineSetPropertyInfo = Style
    attrGet = getStyleUnderlineSet
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleUnderlineSet
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Style
type instance O.AttributeList Style = StyleAttributeList
type StyleAttributeList = ('[ '("background", StyleBackgroundPropertyInfo), '("backgroundSet", StyleBackgroundSetPropertyInfo), '("bold", StyleBoldPropertyInfo), '("boldSet", StyleBoldSetPropertyInfo), '("foreground", StyleForegroundPropertyInfo), '("foregroundSet", StyleForegroundSetPropertyInfo), '("italic", StyleItalicPropertyInfo), '("italicSet", StyleItalicSetPropertyInfo), '("lineBackground", StyleLineBackgroundPropertyInfo), '("lineBackgroundSet", StyleLineBackgroundSetPropertyInfo), '("pangoUnderline", StylePangoUnderlinePropertyInfo), '("scale", StyleScalePropertyInfo), '("scaleSet", StyleScaleSetPropertyInfo), '("strikethrough", StyleStrikethroughPropertyInfo), '("strikethroughSet", StyleStrikethroughSetPropertyInfo), '("underline", StyleUnderlinePropertyInfo), '("underlineColor", StyleUnderlineColorPropertyInfo), '("underlineColorSet", StyleUnderlineColorSetPropertyInfo), '("underlineSet", StyleUnderlineSetPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
styleBackground :: AttrLabelProxy "background"
styleBackground = AttrLabelProxy

styleBackgroundSet :: AttrLabelProxy "backgroundSet"
styleBackgroundSet = AttrLabelProxy

styleBold :: AttrLabelProxy "bold"
styleBold = AttrLabelProxy

styleBoldSet :: AttrLabelProxy "boldSet"
styleBoldSet = AttrLabelProxy

styleForeground :: AttrLabelProxy "foreground"
styleForeground = AttrLabelProxy

styleForegroundSet :: AttrLabelProxy "foregroundSet"
styleForegroundSet = AttrLabelProxy

styleItalic :: AttrLabelProxy "italic"
styleItalic = AttrLabelProxy

styleItalicSet :: AttrLabelProxy "italicSet"
styleItalicSet = AttrLabelProxy

styleLineBackground :: AttrLabelProxy "lineBackground"
styleLineBackground = AttrLabelProxy

styleLineBackgroundSet :: AttrLabelProxy "lineBackgroundSet"
styleLineBackgroundSet = AttrLabelProxy

stylePangoUnderline :: AttrLabelProxy "pangoUnderline"
stylePangoUnderline = AttrLabelProxy

styleScale :: AttrLabelProxy "scale"
styleScale = AttrLabelProxy

styleScaleSet :: AttrLabelProxy "scaleSet"
styleScaleSet = AttrLabelProxy

styleStrikethrough :: AttrLabelProxy "strikethrough"
styleStrikethrough = AttrLabelProxy

styleStrikethroughSet :: AttrLabelProxy "strikethroughSet"
styleStrikethroughSet = AttrLabelProxy

styleUnderline :: AttrLabelProxy "underline"
styleUnderline = AttrLabelProxy

styleUnderlineColor :: AttrLabelProxy "underlineColor"
styleUnderlineColor = AttrLabelProxy

styleUnderlineColorSet :: AttrLabelProxy "underlineColorSet"
styleUnderlineColorSet = AttrLabelProxy

styleUnderlineSet :: AttrLabelProxy "underlineSet"
styleUnderlineSet = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Style = StyleSignalList
type StyleSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Style::apply
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "style"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Style" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceStyle to apply, or %NULL."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "tag"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "TextTag" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkTextTag to apply styles to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_style_apply" gtk_source_style_apply :: 
    Ptr Style ->                            -- style : TInterface (Name {namespace = "GtkSource", name = "Style"})
    Ptr Gtk.TextTag.TextTag ->              -- tag : TInterface (Name {namespace = "Gtk", name = "TextTag"})
    IO ()

-- | This function modifies the t'GI.Gtk.Objects.TextTag.TextTag' properties that are related to the
-- t'GI.GtkSource.Objects.Style.Style' properties. Other t'GI.Gtk.Objects.TextTag.TextTag' properties are left untouched.
-- 
-- If /@style@/ is non-'P.Nothing', applies /@style@/ to /@tag@/.
-- 
-- If /@style@/ is 'P.Nothing', the related *-set properties of t'GI.Gtk.Objects.TextTag.TextTag' are set to
-- 'P.False'.
-- 
-- /Since: 3.22/
styleApply ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyle a, Gtk.TextTag.IsTextTag b) =>
    a
    -- ^ /@style@/: a t'GI.GtkSource.Objects.Style.Style' to apply, or 'P.Nothing'.
    -> b
    -- ^ /@tag@/: a t'GI.Gtk.Objects.TextTag.TextTag' to apply styles to.
    -> m ()
styleApply :: a -> b -> m ()
styleApply style :: a
style tag :: b
tag = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Style
style' <- a -> IO (Ptr Style)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
style
    Ptr TextTag
tag' <- b -> IO (Ptr TextTag)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
tag
    Ptr Style -> Ptr TextTag -> IO ()
gtk_source_style_apply Ptr Style
style' Ptr TextTag
tag'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
style
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
tag
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StyleApplyMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsStyle a, Gtk.TextTag.IsTextTag b) => O.MethodInfo StyleApplyMethodInfo a signature where
    overloadedMethod = styleApply

#endif

-- method Style::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "style"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "Style" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceStyle structure to copy."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GtkSource" , name = "Style" })
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_style_copy" gtk_source_style_copy :: 
    Ptr Style ->                            -- style : TInterface (Name {namespace = "GtkSource", name = "Style"})
    IO (Ptr Style)

-- | Creates a copy of /@style@/, that is a new t'GI.GtkSource.Objects.Style.Style' instance which
-- has the same attributes set.
-- 
-- /Since: 2.0/
styleCopy ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyle a) =>
    a
    -- ^ /@style@/: a t'GI.GtkSource.Objects.Style.Style' structure to copy.
    -> m Style
    -- ^ __Returns:__ copy of /@style@/, call 'GI.GObject.Objects.Object.objectUnref'
    -- when you are done with it.
styleCopy :: a -> m Style
styleCopy style :: a
style = IO Style -> m Style
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Style -> m Style) -> IO Style -> m Style
forall a b. (a -> b) -> a -> b
$ do
    Ptr Style
style' <- a -> IO (Ptr Style)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
style
    Ptr Style
result <- Ptr Style -> IO (Ptr Style)
gtk_source_style_copy Ptr Style
style'
    Text -> Ptr Style -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "styleCopy" Ptr Style
result
    Style
result' <- ((ManagedPtr Style -> Style) -> Ptr Style -> IO Style
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Style -> Style
Style) Ptr Style
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
style
    Style -> IO Style
forall (m :: * -> *) a. Monad m => a -> m a
return Style
result'

#if defined(ENABLE_OVERLOADING)
data StyleCopyMethodInfo
instance (signature ~ (m Style), MonadIO m, IsStyle a) => O.MethodInfo StyleCopyMethodInfo a signature where
    overloadedMethod = styleCopy

#endif