{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A class for managing application-wide styling.
-- 
-- @AdwStyleManager@ provides a way to query and influence the application
-- styles, such as whether to use dark or high contrast appearance.
-- 
-- It allows to set the color scheme via the
-- [property/@styleManager@/:color-scheme] property, and to query the current
-- appearance, as well as whether a system-wide color scheme preference exists.
-- 
-- /Since: 1.0/

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

module GI.Adw.Objects.StyleManager
    ( 

-- * Exported types
    StyleManager(..)                        ,
    IsStyleManager                          ,
    toStyleManager                          ,


 -- * 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
-- [getColorScheme]("GI.Adw.Objects.StyleManager#g:method:getColorScheme"), [getDark]("GI.Adw.Objects.StyleManager#g:method:getDark"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDisplay]("GI.Adw.Objects.StyleManager#g:method:getDisplay"), [getHighContrast]("GI.Adw.Objects.StyleManager#g:method:getHighContrast"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSystemSupportsColorSchemes]("GI.Adw.Objects.StyleManager#g:method:getSystemSupportsColorSchemes").
-- 
-- ==== Setters
-- [setColorScheme]("GI.Adw.Objects.StyleManager#g:method:setColorScheme"), [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)
    ResolveStyleManagerMethod               ,
#endif

-- ** getColorScheme #method:getColorScheme#

#if defined(ENABLE_OVERLOADING)
    StyleManagerGetColorSchemeMethodInfo    ,
#endif
    styleManagerGetColorScheme              ,


-- ** getDark #method:getDark#

#if defined(ENABLE_OVERLOADING)
    StyleManagerGetDarkMethodInfo           ,
#endif
    styleManagerGetDark                     ,


-- ** getDefault #method:getDefault#

    styleManagerGetDefault                  ,


-- ** getDisplay #method:getDisplay#

#if defined(ENABLE_OVERLOADING)
    StyleManagerGetDisplayMethodInfo        ,
#endif
    styleManagerGetDisplay                  ,


-- ** getForDisplay #method:getForDisplay#

    styleManagerGetForDisplay               ,


-- ** getHighContrast #method:getHighContrast#

#if defined(ENABLE_OVERLOADING)
    StyleManagerGetHighContrastMethodInfo   ,
#endif
    styleManagerGetHighContrast             ,


-- ** getSystemSupportsColorSchemes #method:getSystemSupportsColorSchemes#

#if defined(ENABLE_OVERLOADING)
    StyleManagerGetSystemSupportsColorSchemesMethodInfo,
#endif
    styleManagerGetSystemSupportsColorSchemes,


-- ** setColorScheme #method:setColorScheme#

#if defined(ENABLE_OVERLOADING)
    StyleManagerSetColorSchemeMethodInfo    ,
#endif
    styleManagerSetColorScheme              ,




 -- * Properties


-- ** colorScheme #attr:colorScheme#
-- | The requested application color scheme.
-- 
-- The effective appearance will be decided based on the application color
-- scheme and the system preferred color scheme. The
-- [property/@styleManager@/:dark] property can be used to query the current
-- effective appearance.
-- 
-- The @ADW_COLOR_SCHEME_PREFER_LIGHT@ color scheme results in the application
-- using light appearance unless the system prefers dark colors. This is the
-- default value.
-- 
-- The @ADW_COLOR_SCHEME_PREFER_DARK@ color scheme results in the application
-- using dark appearance, but can still switch to the light appearance if the
-- system can prefers it, for example, when the high contrast preference is
-- enabled.
-- 
-- The @ADW_COLOR_SCHEME_FORCE_LIGHT@ and @ADW_COLOR_SCHEME_FORCE_DARK@ values
-- ignore the system preference entirely. They are useful if the application
-- wants to match its UI to its content or to provide a separate color scheme
-- switcher.
-- 
-- If a per-t'GI.Gdk.Objects.Display.Display' style manager has its color scheme set to
-- @ADW_COLOR_SCHEME_DEFAULT@, it will inherit the color scheme from the
-- default style manager.
-- 
-- For the default style manager, @ADW_COLOR_SCHEME_DEFAULT@ is equivalent to
-- @ADW_COLOR_SCHEME_PREFER_LIGHT@.
-- 
-- The [property/@styleManager@/:system-supports-color-schemes] property can be
-- used to check if the current environment provides a color scheme
-- preference.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    StyleManagerColorSchemePropertyInfo     ,
#endif
    constructStyleManagerColorScheme        ,
    getStyleManagerColorScheme              ,
    setStyleManagerColorScheme              ,
#if defined(ENABLE_OVERLOADING)
    styleManagerColorScheme                 ,
#endif


-- ** dark #attr:dark#
-- | Whether the application is using dark appearance.
-- 
-- This property can be used to query the current appearance, as requested via
-- [property/@styleManager@/:color-scheme].
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    StyleManagerDarkPropertyInfo            ,
#endif
    getStyleManagerDark                     ,
#if defined(ENABLE_OVERLOADING)
    styleManagerDark                        ,
#endif


-- ** display #attr:display#
-- | The display the style manager is associated with.
-- 
-- The display will be @NULL@ for the style manager returned by
-- @/StyleManager.get_default/@.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    StyleManagerDisplayPropertyInfo         ,
#endif
    constructStyleManagerDisplay            ,
    getStyleManagerDisplay                  ,
#if defined(ENABLE_OVERLOADING)
    styleManagerDisplay                     ,
#endif


-- ** highContrast #attr:highContrast#
-- | Whether the application is using high contrast appearance.
-- 
-- This cannot be overridden by applications.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    StyleManagerHighContrastPropertyInfo    ,
#endif
    getStyleManagerHighContrast             ,
#if defined(ENABLE_OVERLOADING)
    styleManagerHighContrast                ,
#endif


-- ** systemSupportsColorSchemes #attr:systemSupportsColorSchemes#
-- | Whether the system supports color schemes.
-- 
-- This property can be used to check if the current environment provides a
-- color scheme preference. For example, applications might want to show a
-- separate appearance switcher if it\'s set to @FALSE@.
-- 
-- See [property/@styleManager@/:color-scheme].
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    StyleManagerSystemSupportsColorSchemesPropertyInfo,
#endif
    getStyleManagerSystemSupportsColorSchemes,
#if defined(ENABLE_OVERLOADING)
    styleManagerSystemSupportsColorSchemes  ,
#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.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.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 {-# SOURCE #-} qualified GI.Adw.Enums as Adw.Enums
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Objects.Display as Gdk.Display

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

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

foreign import ccall "adw_style_manager_get_type"
    c_adw_style_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject StyleManager where
    glibType :: IO GType
glibType = IO GType
c_adw_style_manager_get_type

instance B.Types.GObject StyleManager

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveStyleManagerMethod (t :: Symbol) (o :: *) :: * where
    ResolveStyleManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveStyleManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveStyleManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveStyleManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveStyleManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveStyleManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveStyleManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveStyleManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveStyleManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveStyleManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveStyleManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveStyleManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveStyleManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveStyleManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveStyleManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveStyleManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveStyleManagerMethod "getColorScheme" o = StyleManagerGetColorSchemeMethodInfo
    ResolveStyleManagerMethod "getDark" o = StyleManagerGetDarkMethodInfo
    ResolveStyleManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveStyleManagerMethod "getDisplay" o = StyleManagerGetDisplayMethodInfo
    ResolveStyleManagerMethod "getHighContrast" o = StyleManagerGetHighContrastMethodInfo
    ResolveStyleManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveStyleManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveStyleManagerMethod "getSystemSupportsColorSchemes" o = StyleManagerGetSystemSupportsColorSchemesMethodInfo
    ResolveStyleManagerMethod "setColorScheme" o = StyleManagerSetColorSchemeMethodInfo
    ResolveStyleManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveStyleManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveStyleManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveStyleManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "color-scheme"
   -- Type: TInterface (Name {namespace = "Adw", name = "ColorScheme"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@color-scheme@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' styleManager #colorScheme
-- @
getStyleManagerColorScheme :: (MonadIO m, IsStyleManager o) => o -> m Adw.Enums.ColorScheme
getStyleManagerColorScheme :: forall (m :: * -> *) o.
(MonadIO m, IsStyleManager o) =>
o -> m ColorScheme
getStyleManagerColorScheme o
obj = IO ColorScheme -> m ColorScheme
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO ColorScheme -> m ColorScheme)
-> IO ColorScheme -> m ColorScheme
forall a b. (a -> b) -> a -> b
$ o -> String -> IO ColorScheme
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"color-scheme"

-- | Set the value of the “@color-scheme@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' styleManager [ #colorScheme 'Data.GI.Base.Attributes.:=' value ]
-- @
setStyleManagerColorScheme :: (MonadIO m, IsStyleManager o) => o -> Adw.Enums.ColorScheme -> m ()
setStyleManagerColorScheme :: forall (m :: * -> *) o.
(MonadIO m, IsStyleManager o) =>
o -> ColorScheme -> m ()
setStyleManagerColorScheme o
obj ColorScheme
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 -> ColorScheme -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"color-scheme" ColorScheme
val

-- | Construct a `GValueConstruct` with valid value for the “@color-scheme@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleManagerColorScheme :: (IsStyleManager o, MIO.MonadIO m) => Adw.Enums.ColorScheme -> m (GValueConstruct o)
constructStyleManagerColorScheme :: forall o (m :: * -> *).
(IsStyleManager o, MonadIO m) =>
ColorScheme -> m (GValueConstruct o)
constructStyleManagerColorScheme ColorScheme
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 -> ColorScheme -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"color-scheme" ColorScheme
val

#if defined(ENABLE_OVERLOADING)
data StyleManagerColorSchemePropertyInfo
instance AttrInfo StyleManagerColorSchemePropertyInfo where
    type AttrAllowedOps StyleManagerColorSchemePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint StyleManagerColorSchemePropertyInfo = IsStyleManager
    type AttrSetTypeConstraint StyleManagerColorSchemePropertyInfo = (~) Adw.Enums.ColorScheme
    type AttrTransferTypeConstraint StyleManagerColorSchemePropertyInfo = (~) Adw.Enums.ColorScheme
    type AttrTransferType StyleManagerColorSchemePropertyInfo = Adw.Enums.ColorScheme
    type AttrGetType StyleManagerColorSchemePropertyInfo = Adw.Enums.ColorScheme
    type AttrLabel StyleManagerColorSchemePropertyInfo = "color-scheme"
    type AttrOrigin StyleManagerColorSchemePropertyInfo = StyleManager
    attrGet = getStyleManagerColorScheme
    attrSet = setStyleManagerColorScheme
    attrTransfer _ v = do
        return v
    attrConstruct = constructStyleManagerColorScheme
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.colorScheme"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#g:attr:colorScheme"
        })
#endif

-- VVV Prop "dark"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@dark@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' styleManager #dark
-- @
getStyleManagerDark :: (MonadIO m, IsStyleManager o) => o -> m Bool
getStyleManagerDark :: forall (m :: * -> *) o.
(MonadIO m, IsStyleManager o) =>
o -> m Bool
getStyleManagerDark o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"dark"

#if defined(ENABLE_OVERLOADING)
data StyleManagerDarkPropertyInfo
instance AttrInfo StyleManagerDarkPropertyInfo where
    type AttrAllowedOps StyleManagerDarkPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint StyleManagerDarkPropertyInfo = IsStyleManager
    type AttrSetTypeConstraint StyleManagerDarkPropertyInfo = (~) ()
    type AttrTransferTypeConstraint StyleManagerDarkPropertyInfo = (~) ()
    type AttrTransferType StyleManagerDarkPropertyInfo = ()
    type AttrGetType StyleManagerDarkPropertyInfo = Bool
    type AttrLabel StyleManagerDarkPropertyInfo = "dark"
    type AttrOrigin StyleManagerDarkPropertyInfo = StyleManager
    attrGet = getStyleManagerDark
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.dark"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#g:attr:dark"
        })
#endif

-- VVV Prop "display"
   -- Type: TInterface (Name {namespace = "Gdk", name = "Display"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

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

-- | Construct a `GValueConstruct` with valid value for the “@display@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructStyleManagerDisplay :: (IsStyleManager o, MIO.MonadIO m, Gdk.Display.IsDisplay a) => a -> m (GValueConstruct o)
constructStyleManagerDisplay :: forall o (m :: * -> *) a.
(IsStyleManager o, MonadIO m, IsDisplay a) =>
a -> m (GValueConstruct o)
constructStyleManagerDisplay 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
"display" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data StyleManagerDisplayPropertyInfo
instance AttrInfo StyleManagerDisplayPropertyInfo where
    type AttrAllowedOps StyleManagerDisplayPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint StyleManagerDisplayPropertyInfo = IsStyleManager
    type AttrSetTypeConstraint StyleManagerDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferTypeConstraint StyleManagerDisplayPropertyInfo = Gdk.Display.IsDisplay
    type AttrTransferType StyleManagerDisplayPropertyInfo = Gdk.Display.Display
    type AttrGetType StyleManagerDisplayPropertyInfo = Gdk.Display.Display
    type AttrLabel StyleManagerDisplayPropertyInfo = "display"
    type AttrOrigin StyleManagerDisplayPropertyInfo = StyleManager
    attrGet = getStyleManagerDisplay
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gdk.Display.Display v
    attrConstruct = constructStyleManagerDisplay
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.display"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#g:attr:display"
        })
#endif

-- VVV Prop "high-contrast"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@high-contrast@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' styleManager #highContrast
-- @
getStyleManagerHighContrast :: (MonadIO m, IsStyleManager o) => o -> m Bool
getStyleManagerHighContrast :: forall (m :: * -> *) o.
(MonadIO m, IsStyleManager o) =>
o -> m Bool
getStyleManagerHighContrast o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"high-contrast"

#if defined(ENABLE_OVERLOADING)
data StyleManagerHighContrastPropertyInfo
instance AttrInfo StyleManagerHighContrastPropertyInfo where
    type AttrAllowedOps StyleManagerHighContrastPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint StyleManagerHighContrastPropertyInfo = IsStyleManager
    type AttrSetTypeConstraint StyleManagerHighContrastPropertyInfo = (~) ()
    type AttrTransferTypeConstraint StyleManagerHighContrastPropertyInfo = (~) ()
    type AttrTransferType StyleManagerHighContrastPropertyInfo = ()
    type AttrGetType StyleManagerHighContrastPropertyInfo = Bool
    type AttrLabel StyleManagerHighContrastPropertyInfo = "high-contrast"
    type AttrOrigin StyleManagerHighContrastPropertyInfo = StyleManager
    attrGet = getStyleManagerHighContrast
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.highContrast"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#g:attr:highContrast"
        })
#endif

-- VVV Prop "system-supports-color-schemes"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@system-supports-color-schemes@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' styleManager #systemSupportsColorSchemes
-- @
getStyleManagerSystemSupportsColorSchemes :: (MonadIO m, IsStyleManager o) => o -> m Bool
getStyleManagerSystemSupportsColorSchemes :: forall (m :: * -> *) o.
(MonadIO m, IsStyleManager o) =>
o -> m Bool
getStyleManagerSystemSupportsColorSchemes o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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 String
"system-supports-color-schemes"

#if defined(ENABLE_OVERLOADING)
data StyleManagerSystemSupportsColorSchemesPropertyInfo
instance AttrInfo StyleManagerSystemSupportsColorSchemesPropertyInfo where
    type AttrAllowedOps StyleManagerSystemSupportsColorSchemesPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint StyleManagerSystemSupportsColorSchemesPropertyInfo = IsStyleManager
    type AttrSetTypeConstraint StyleManagerSystemSupportsColorSchemesPropertyInfo = (~) ()
    type AttrTransferTypeConstraint StyleManagerSystemSupportsColorSchemesPropertyInfo = (~) ()
    type AttrTransferType StyleManagerSystemSupportsColorSchemesPropertyInfo = ()
    type AttrGetType StyleManagerSystemSupportsColorSchemesPropertyInfo = Bool
    type AttrLabel StyleManagerSystemSupportsColorSchemesPropertyInfo = "system-supports-color-schemes"
    type AttrOrigin StyleManagerSystemSupportsColorSchemesPropertyInfo = StyleManager
    attrGet = getStyleManagerSystemSupportsColorSchemes
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.systemSupportsColorSchemes"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#g:attr:systemSupportsColorSchemes"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList StyleManager
type instance O.AttributeList StyleManager = StyleManagerAttributeList
type StyleManagerAttributeList = ('[ '("colorScheme", StyleManagerColorSchemePropertyInfo), '("dark", StyleManagerDarkPropertyInfo), '("display", StyleManagerDisplayPropertyInfo), '("highContrast", StyleManagerHighContrastPropertyInfo), '("systemSupportsColorSchemes", StyleManagerSystemSupportsColorSchemesPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
styleManagerColorScheme :: AttrLabelProxy "colorScheme"
styleManagerColorScheme = AttrLabelProxy

styleManagerDark :: AttrLabelProxy "dark"
styleManagerDark = AttrLabelProxy

styleManagerDisplay :: AttrLabelProxy "display"
styleManagerDisplay = AttrLabelProxy

styleManagerHighContrast :: AttrLabelProxy "highContrast"
styleManagerHighContrast = AttrLabelProxy

styleManagerSystemSupportsColorSchemes :: AttrLabelProxy "systemSupportsColorSchemes"
styleManagerSystemSupportsColorSchemes = AttrLabelProxy

#endif

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

#endif

-- method StyleManager::get_color_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "StyleManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a style manager" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Adw" , name = "ColorScheme" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_style_manager_get_color_scheme" adw_style_manager_get_color_scheme :: 
    Ptr StyleManager ->                     -- self : TInterface (Name {namespace = "Adw", name = "StyleManager"})
    IO CUInt

-- | Gets the requested application color scheme.
-- 
-- /Since: 1.0/
styleManagerGetColorScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleManager a) =>
    a
    -- ^ /@self@/: a style manager
    -> m Adw.Enums.ColorScheme
    -- ^ __Returns:__ the color scheme
styleManagerGetColorScheme :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStyleManager a) =>
a -> m ColorScheme
styleManagerGetColorScheme a
self = IO ColorScheme -> m ColorScheme
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ColorScheme -> m ColorScheme)
-> IO ColorScheme -> m ColorScheme
forall a b. (a -> b) -> a -> b
$ do
    Ptr StyleManager
self' <- a -> IO (Ptr StyleManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr StyleManager -> IO CUInt
adw_style_manager_get_color_scheme Ptr StyleManager
self'
    let result' :: ColorScheme
result' = (Int -> ColorScheme
forall a. Enum a => Int -> a
toEnum (Int -> ColorScheme) -> (CUInt -> Int) -> CUInt -> ColorScheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    ColorScheme -> IO ColorScheme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColorScheme
result'

#if defined(ENABLE_OVERLOADING)
data StyleManagerGetColorSchemeMethodInfo
instance (signature ~ (m Adw.Enums.ColorScheme), MonadIO m, IsStyleManager a) => O.OverloadedMethod StyleManagerGetColorSchemeMethodInfo a signature where
    overloadedMethod = styleManagerGetColorScheme

instance O.OverloadedMethodInfo StyleManagerGetColorSchemeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.styleManagerGetColorScheme",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#v:styleManagerGetColorScheme"
        })


#endif

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

foreign import ccall "adw_style_manager_get_dark" adw_style_manager_get_dark :: 
    Ptr StyleManager ->                     -- self : TInterface (Name {namespace = "Adw", name = "StyleManager"})
    IO CInt

-- | Gets whether the application is using dark appearance.
-- 
-- This can be used to query the current appearance, as requested via
-- [property/@styleManager@/:color-scheme].
-- 
-- /Since: 1.0/
styleManagerGetDark ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleManager a) =>
    a
    -- ^ /@self@/: a style manager
    -> m Bool
    -- ^ __Returns:__ whether the application is using dark appearance
styleManagerGetDark :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStyleManager a) =>
a -> m Bool
styleManagerGetDark a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr StyleManager
self' <- a -> IO (Ptr StyleManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr StyleManager -> IO CInt
adw_style_manager_get_dark Ptr StyleManager
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StyleManagerGetDarkMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStyleManager a) => O.OverloadedMethod StyleManagerGetDarkMethodInfo a signature where
    overloadedMethod = styleManagerGetDark

instance O.OverloadedMethodInfo StyleManagerGetDarkMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.styleManagerGetDark",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#v:styleManagerGetDark"
        })


#endif

-- method StyleManager::get_display
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "StyleManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a style manager" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gdk" , name = "Display" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_style_manager_get_display" adw_style_manager_get_display :: 
    Ptr StyleManager ->                     -- self : TInterface (Name {namespace = "Adw", name = "StyleManager"})
    IO (Ptr Gdk.Display.Display)

-- | Gets the display the style manager is associated with.
-- 
-- The display will be @NULL@ for the style manager returned by
-- @/StyleManager.get_default/@.
-- 
-- /Since: 1.0/
styleManagerGetDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleManager a) =>
    a
    -- ^ /@self@/: a style manager
    -> m Gdk.Display.Display
    -- ^ __Returns:__ (nullable): the display
styleManagerGetDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStyleManager a) =>
a -> m Display
styleManagerGetDisplay a
self = IO Display -> m Display
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Display -> m Display) -> IO Display -> m Display
forall a b. (a -> b) -> a -> b
$ do
    Ptr StyleManager
self' <- a -> IO (Ptr StyleManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Display
result <- Ptr StyleManager -> IO (Ptr Display)
adw_style_manager_get_display Ptr StyleManager
self'
    Text -> Ptr Display -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"styleManagerGetDisplay" Ptr Display
result
    Display
result' <- ((ManagedPtr Display -> Display) -> Ptr Display -> IO Display
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Display -> Display
Gdk.Display.Display) Ptr Display
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Display -> IO Display
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Display
result'

#if defined(ENABLE_OVERLOADING)
data StyleManagerGetDisplayMethodInfo
instance (signature ~ (m Gdk.Display.Display), MonadIO m, IsStyleManager a) => O.OverloadedMethod StyleManagerGetDisplayMethodInfo a signature where
    overloadedMethod = styleManagerGetDisplay

instance O.OverloadedMethodInfo StyleManagerGetDisplayMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.styleManagerGetDisplay",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#v:styleManagerGetDisplay"
        })


#endif

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

foreign import ccall "adw_style_manager_get_high_contrast" adw_style_manager_get_high_contrast :: 
    Ptr StyleManager ->                     -- self : TInterface (Name {namespace = "Adw", name = "StyleManager"})
    IO CInt

-- | Gets whether the application is using high contrast appearance.
-- 
-- This cannot be overridden by applications.
-- 
-- /Since: 1.0/
styleManagerGetHighContrast ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleManager a) =>
    a
    -- ^ /@self@/: a style manager
    -> m Bool
    -- ^ __Returns:__ whether the application is using high contrast appearance
styleManagerGetHighContrast :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStyleManager a) =>
a -> m Bool
styleManagerGetHighContrast a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr StyleManager
self' <- a -> IO (Ptr StyleManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr StyleManager -> IO CInt
adw_style_manager_get_high_contrast Ptr StyleManager
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StyleManagerGetHighContrastMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStyleManager a) => O.OverloadedMethod StyleManagerGetHighContrastMethodInfo a signature where
    overloadedMethod = styleManagerGetHighContrast

instance O.OverloadedMethodInfo StyleManagerGetHighContrastMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.styleManagerGetHighContrast",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#v:styleManagerGetHighContrast"
        })


#endif

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

foreign import ccall "adw_style_manager_get_system_supports_color_schemes" adw_style_manager_get_system_supports_color_schemes :: 
    Ptr StyleManager ->                     -- self : TInterface (Name {namespace = "Adw", name = "StyleManager"})
    IO CInt

-- | Gets whether the system supports color schemes.
-- 
-- This can be used to check if the current environment provides a color scheme
-- preference. For example, applications might want to show a separate
-- appearance switcher if it\'s set to @FALSE@.
-- 
-- /Since: 1.0/
styleManagerGetSystemSupportsColorSchemes ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleManager a) =>
    a
    -- ^ /@self@/: a style manager
    -> m Bool
    -- ^ __Returns:__ whether the system supports color schemes
styleManagerGetSystemSupportsColorSchemes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStyleManager a) =>
a -> m Bool
styleManagerGetSystemSupportsColorSchemes a
self = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr StyleManager
self' <- a -> IO (Ptr StyleManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr StyleManager -> IO CInt
adw_style_manager_get_system_supports_color_schemes Ptr StyleManager
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data StyleManagerGetSystemSupportsColorSchemesMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsStyleManager a) => O.OverloadedMethod StyleManagerGetSystemSupportsColorSchemesMethodInfo a signature where
    overloadedMethod = styleManagerGetSystemSupportsColorSchemes

instance O.OverloadedMethodInfo StyleManagerGetSystemSupportsColorSchemesMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.styleManagerGetSystemSupportsColorSchemes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#v:styleManagerGetSystemSupportsColorSchemes"
        })


#endif

-- method StyleManager::set_color_scheme
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "StyleManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a style manager" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "color_scheme"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "ColorScheme" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the color scheme" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "adw_style_manager_set_color_scheme" adw_style_manager_set_color_scheme :: 
    Ptr StyleManager ->                     -- self : TInterface (Name {namespace = "Adw", name = "StyleManager"})
    CUInt ->                                -- color_scheme : TInterface (Name {namespace = "Adw", name = "ColorScheme"})
    IO ()

-- | Sets the requested application color scheme.
-- 
-- The effective appearance will be decided based on the application color
-- scheme and the system preferred color scheme. The
-- [property/@styleManager@/:dark] property can be used to query the current
-- effective appearance.
-- 
-- The @ADW_COLOR_SCHEME_PREFER_LIGHT@ color scheme results in the application
-- using light appearance unless the system prefers dark colors. This is the
-- default value.
-- 
-- The @ADW_COLOR_SCHEME_PREFER_DARK@ color scheme results in the application
-- using dark appearance, but can still switch to the light appearance if the
-- system can prefers it, for example, when the high contrast preference is
-- enabled.
-- 
-- The @ADW_COLOR_SCHEME_FORCE_LIGHT@ and @ADW_COLOR_SCHEME_FORCE_DARK@ values
-- ignore the system preference entirely. They are useful if the application
-- wants to match its UI to its content or to provide a separate color scheme
-- switcher.
-- 
-- If a per-t'GI.Gdk.Objects.Display.Display' style manager has its color scheme set to
-- @ADW_COLOR_SCHEME_DEFAULT@, it will inherit the color scheme from the
-- default style manager.
-- 
-- For the default style manager, @ADW_COLOR_SCHEME_DEFAULT@ is equivalent to
-- @ADW_COLOR_SCHEME_PREFER_LIGHT@.
-- 
-- The [property/@styleManager@/:system-supports-color-schemes] property can be
-- used to check if the current environment provides a color scheme
-- preference.
-- 
-- /Since: 1.0/
styleManagerSetColorScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsStyleManager a) =>
    a
    -- ^ /@self@/: a style manager
    -> Adw.Enums.ColorScheme
    -- ^ /@colorScheme@/: the color scheme
    -> m ()
styleManagerSetColorScheme :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsStyleManager a) =>
a -> ColorScheme -> m ()
styleManagerSetColorScheme a
self ColorScheme
colorScheme = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr StyleManager
self' <- a -> IO (Ptr StyleManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let colorScheme' :: CUInt
colorScheme' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ColorScheme -> Int) -> ColorScheme -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorScheme -> Int
forall a. Enum a => a -> Int
fromEnum) ColorScheme
colorScheme
    Ptr StyleManager -> CUInt -> IO ()
adw_style_manager_set_color_scheme Ptr StyleManager
self' CUInt
colorScheme'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data StyleManagerSetColorSchemeMethodInfo
instance (signature ~ (Adw.Enums.ColorScheme -> m ()), MonadIO m, IsStyleManager a) => O.OverloadedMethod StyleManagerSetColorSchemeMethodInfo a signature where
    overloadedMethod = styleManagerSetColorScheme

instance O.OverloadedMethodInfo StyleManagerSetColorSchemeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Adw.Objects.StyleManager.styleManagerSetColorScheme",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-adwaita-1.0.3/docs/GI-Adw-Objects-StyleManager.html#v:styleManagerSetColorScheme"
        })


#endif

-- method StyleManager::get_default
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Adw" , name = "StyleManager" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_style_manager_get_default" adw_style_manager_get_default :: 
    IO (Ptr StyleManager)

-- | Gets the default @AdwStyleManager@ instance.
-- 
-- It manages all t'GI.Gdk.Objects.Display.Display' instances unless the style manager for
-- that display has an override.
-- 
-- See @/StyleManager.get_for_display/@.
-- 
-- /Since: 1.0/
styleManagerGetDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m StyleManager
    -- ^ __Returns:__ the default style manager
styleManagerGetDefault :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m StyleManager
styleManagerGetDefault  = IO StyleManager -> m StyleManager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StyleManager -> m StyleManager)
-> IO StyleManager -> m StyleManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr StyleManager
result <- IO (Ptr StyleManager)
adw_style_manager_get_default
    Text -> Ptr StyleManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"styleManagerGetDefault" Ptr StyleManager
result
    StyleManager
result' <- ((ManagedPtr StyleManager -> StyleManager)
-> Ptr StyleManager -> IO StyleManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr StyleManager -> StyleManager
StyleManager) Ptr StyleManager
result
    StyleManager -> IO StyleManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StyleManager
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method StyleManager::get_for_display
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "display"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "Display" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GdkDisplay`" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Adw" , name = "StyleManager" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_style_manager_get_for_display" adw_style_manager_get_for_display :: 
    Ptr Gdk.Display.Display ->              -- display : TInterface (Name {namespace = "Gdk", name = "Display"})
    IO (Ptr StyleManager)

-- | Gets the @AdwStyleManager@ instance managing /@display@/.
-- 
-- It can be used to override styles for that specific display instead of the
-- whole application.
-- 
-- Most applications should use @/StyleManager.get_default/@ instead.
-- 
-- /Since: 1.0/
styleManagerGetForDisplay ::
    (B.CallStack.HasCallStack, MonadIO m, Gdk.Display.IsDisplay a) =>
    a
    -- ^ /@display@/: a @GdkDisplay@
    -> m StyleManager
    -- ^ __Returns:__ the style manager for /@display@/
styleManagerGetForDisplay :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsDisplay a) =>
a -> m StyleManager
styleManagerGetForDisplay a
display = IO StyleManager -> m StyleManager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StyleManager -> m StyleManager)
-> IO StyleManager -> m StyleManager
forall a b. (a -> b) -> a -> b
$ do
    Ptr Display
display' <- a -> IO (Ptr Display)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
display
    Ptr StyleManager
result <- Ptr Display -> IO (Ptr StyleManager)
adw_style_manager_get_for_display Ptr Display
display'
    Text -> Ptr StyleManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"styleManagerGetForDisplay" Ptr StyleManager
result
    StyleManager
result' <- ((ManagedPtr StyleManager -> StyleManager)
-> Ptr StyleManager -> IO StyleManager
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr StyleManager -> StyleManager
StyleManager) Ptr StyleManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
display
    StyleManager -> IO StyleManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StyleManager
result'

#if defined(ENABLE_OVERLOADING)
#endif