{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A base class for Adwaita applications.
-- 
-- @AdwApplication@ handles library initialization by calling [func/@init@/] in the
-- default [Application::startup]("GI.Gio.Objects.Application#g:signal:startup") signal handler, in turn chaining up
-- as required by t'GI.Gtk.Objects.Application.Application'. Therefore, any subclass of
-- @AdwApplication@ should always chain up its @startup@ handler before using
-- any Adwaita or GTK API.
-- 
-- == Automatic Resources
-- 
-- @AdwApplication@ will automatically load stylesheets located in the
-- application\'s resource base path (see
-- 'GI.Gio.Objects.Application.applicationSetResourceBasePath', if they\'re present.
-- 
-- They can be used to add custom styles to the application, as follows:
-- 
-- * @style.css@ contains styles that are always present.
-- * @style-dark.css@ contains styles only used when
-- 
-- [property/@styleManager@/:dark] is @TRUE@.
-- 
-- * @style-hc.css@ contains styles used when the system high contrast
-- preference is enabled.
-- * @style-hc-dark.css@ contains styles used when the system high contrast
-- preference is enabled and [property/@styleManager@/:dark] is @TRUE@.
-- 
-- 
-- /Since: 1.0/

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

module GI.Adw.Objects.Application
    ( 

-- * Exported types
    Application(..)                         ,
    IsApplication                           ,
    toApplication                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [actionAdded]("GI.Gio.Interfaces.ActionGroup#g:method:actionAdded"), [actionEnabledChanged]("GI.Gio.Interfaces.ActionGroup#g:method:actionEnabledChanged"), [actionRemoved]("GI.Gio.Interfaces.ActionGroup#g:method:actionRemoved"), [actionStateChanged]("GI.Gio.Interfaces.ActionGroup#g:method:actionStateChanged"), [activate]("GI.Gio.Objects.Application#g:method:activate"), [activateAction]("GI.Gio.Interfaces.ActionGroup#g:method:activateAction"), [addAction]("GI.Gio.Interfaces.ActionMap#g:method:addAction"), [addActionEntries]("GI.Gio.Interfaces.ActionMap#g:method:addActionEntries"), [addMainOption]("GI.Gio.Objects.Application#g:method:addMainOption"), [addMainOptionEntries]("GI.Gio.Objects.Application#g:method:addMainOptionEntries"), [addOptionGroup]("GI.Gio.Objects.Application#g:method:addOptionGroup"), [addWindow]("GI.Gtk.Objects.Application#g:method:addWindow"), [bindBusyProperty]("GI.Gio.Objects.Application#g:method:bindBusyProperty"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [changeActionState]("GI.Gio.Interfaces.ActionGroup#g:method:changeActionState"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasAction]("GI.Gio.Interfaces.ActionGroup#g:method:hasAction"), [hold]("GI.Gio.Objects.Application#g:method:hold"), [inhibit]("GI.Gtk.Objects.Application#g:method:inhibit"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [listActionDescriptions]("GI.Gtk.Objects.Application#g:method:listActionDescriptions"), [listActions]("GI.Gio.Interfaces.ActionGroup#g:method:listActions"), [lookupAction]("GI.Gio.Interfaces.ActionMap#g:method:lookupAction"), [markBusy]("GI.Gio.Objects.Application#g:method:markBusy"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [open]("GI.Gio.Objects.Application#g:method:open"), [queryAction]("GI.Gio.Interfaces.ActionGroup#g:method:queryAction"), [quit]("GI.Gio.Objects.Application#g:method:quit"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [register]("GI.Gio.Objects.Application#g:method:register"), [release]("GI.Gio.Objects.Application#g:method:release"), [removeAction]("GI.Gio.Interfaces.ActionMap#g:method:removeAction"), [removeWindow]("GI.Gtk.Objects.Application#g:method:removeWindow"), [run]("GI.Gio.Objects.Application#g:method:run"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [sendNotification]("GI.Gio.Objects.Application#g:method:sendNotification"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unbindBusyProperty]("GI.Gio.Objects.Application#g:method:unbindBusyProperty"), [uninhibit]("GI.Gtk.Objects.Application#g:method:uninhibit"), [unmarkBusy]("GI.Gio.Objects.Application#g:method:unmarkBusy"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure"), [withdrawNotification]("GI.Gio.Objects.Application#g:method:withdrawNotification").
-- 
-- ==== Getters
-- [getAccelsForAction]("GI.Gtk.Objects.Application#g:method:getAccelsForAction"), [getActionEnabled]("GI.Gio.Interfaces.ActionGroup#g:method:getActionEnabled"), [getActionParameterType]("GI.Gio.Interfaces.ActionGroup#g:method:getActionParameterType"), [getActionState]("GI.Gio.Interfaces.ActionGroup#g:method:getActionState"), [getActionStateHint]("GI.Gio.Interfaces.ActionGroup#g:method:getActionStateHint"), [getActionStateType]("GI.Gio.Interfaces.ActionGroup#g:method:getActionStateType"), [getActionsForAccel]("GI.Gtk.Objects.Application#g:method:getActionsForAccel"), [getActiveWindow]("GI.Gtk.Objects.Application#g:method:getActiveWindow"), [getApplicationId]("GI.Gio.Objects.Application#g:method:getApplicationId"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDbusConnection]("GI.Gio.Objects.Application#g:method:getDbusConnection"), [getDbusObjectPath]("GI.Gio.Objects.Application#g:method:getDbusObjectPath"), [getFlags]("GI.Gio.Objects.Application#g:method:getFlags"), [getInactivityTimeout]("GI.Gio.Objects.Application#g:method:getInactivityTimeout"), [getIsBusy]("GI.Gio.Objects.Application#g:method:getIsBusy"), [getIsRegistered]("GI.Gio.Objects.Application#g:method:getIsRegistered"), [getIsRemote]("GI.Gio.Objects.Application#g:method:getIsRemote"), [getMenuById]("GI.Gtk.Objects.Application#g:method:getMenuById"), [getMenubar]("GI.Gtk.Objects.Application#g:method:getMenubar"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getResourceBasePath]("GI.Gio.Objects.Application#g:method:getResourceBasePath"), [getStyleManager]("GI.Adw.Objects.Application#g:method:getStyleManager"), [getWindowById]("GI.Gtk.Objects.Application#g:method:getWindowById"), [getWindows]("GI.Gtk.Objects.Application#g:method:getWindows").
-- 
-- ==== Setters
-- [setAccelsForAction]("GI.Gtk.Objects.Application#g:method:setAccelsForAction"), [setActionGroup]("GI.Gio.Objects.Application#g:method:setActionGroup"), [setApplicationId]("GI.Gio.Objects.Application#g:method:setApplicationId"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setDefault]("GI.Gio.Objects.Application#g:method:setDefault"), [setFlags]("GI.Gio.Objects.Application#g:method:setFlags"), [setInactivityTimeout]("GI.Gio.Objects.Application#g:method:setInactivityTimeout"), [setMenubar]("GI.Gtk.Objects.Application#g:method:setMenubar"), [setOptionContextDescription]("GI.Gio.Objects.Application#g:method:setOptionContextDescription"), [setOptionContextParameterString]("GI.Gio.Objects.Application#g:method:setOptionContextParameterString"), [setOptionContextSummary]("GI.Gio.Objects.Application#g:method:setOptionContextSummary"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setResourceBasePath]("GI.Gio.Objects.Application#g:method:setResourceBasePath").

#if defined(ENABLE_OVERLOADING)
    ResolveApplicationMethod                ,
#endif

-- ** getStyleManager #method:getStyleManager#

#if defined(ENABLE_OVERLOADING)
    ApplicationGetStyleManagerMethodInfo    ,
#endif
    applicationGetStyleManager              ,


-- ** new #method:new#

    applicationNew                          ,




 -- * Properties


-- ** styleManager #attr:styleManager#
-- | The style manager for this application.
-- 
-- This is a convenience property allowing to access @AdwStyleManager@ through
-- property bindings or expressions.
-- 
-- /Since: 1.0/

#if defined(ENABLE_OVERLOADING)
    ApplicationStyleManagerPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    applicationStyleManager                 ,
#endif
    getApplicationStyleManager              ,




    ) 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.Objects.StyleManager as Adw.StyleManager
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.ActionGroup as Gio.ActionGroup
import qualified GI.Gio.Interfaces.ActionMap as Gio.ActionMap
import qualified GI.Gio.Objects.Application as Gio.Application
import qualified GI.Gtk.Objects.Application as Gtk.Application

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

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

foreign import ccall "adw_application_get_type"
    c_adw_application_get_type :: IO B.Types.GType

instance B.Types.TypedObject Application where
    glibType :: IO GType
glibType = IO GType
c_adw_application_get_type

instance B.Types.GObject Application

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

instance O.HasParentTypes Application
type instance O.ParentTypes Application = '[Gtk.Application.Application, Gio.Application.Application, GObject.Object.Object, Gio.ActionGroup.ActionGroup, Gio.ActionMap.ActionMap]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveApplicationMethod (t :: Symbol) (o :: *) :: * where
    ResolveApplicationMethod "actionAdded" o = Gio.ActionGroup.ActionGroupActionAddedMethodInfo
    ResolveApplicationMethod "actionEnabledChanged" o = Gio.ActionGroup.ActionGroupActionEnabledChangedMethodInfo
    ResolveApplicationMethod "actionRemoved" o = Gio.ActionGroup.ActionGroupActionRemovedMethodInfo
    ResolveApplicationMethod "actionStateChanged" o = Gio.ActionGroup.ActionGroupActionStateChangedMethodInfo
    ResolveApplicationMethod "activate" o = Gio.Application.ApplicationActivateMethodInfo
    ResolveApplicationMethod "activateAction" o = Gio.ActionGroup.ActionGroupActivateActionMethodInfo
    ResolveApplicationMethod "addAction" o = Gio.ActionMap.ActionMapAddActionMethodInfo
    ResolveApplicationMethod "addActionEntries" o = Gio.ActionMap.ActionMapAddActionEntriesMethodInfo
    ResolveApplicationMethod "addMainOption" o = Gio.Application.ApplicationAddMainOptionMethodInfo
    ResolveApplicationMethod "addMainOptionEntries" o = Gio.Application.ApplicationAddMainOptionEntriesMethodInfo
    ResolveApplicationMethod "addOptionGroup" o = Gio.Application.ApplicationAddOptionGroupMethodInfo
    ResolveApplicationMethod "addWindow" o = Gtk.Application.ApplicationAddWindowMethodInfo
    ResolveApplicationMethod "bindBusyProperty" o = Gio.Application.ApplicationBindBusyPropertyMethodInfo
    ResolveApplicationMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveApplicationMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveApplicationMethod "changeActionState" o = Gio.ActionGroup.ActionGroupChangeActionStateMethodInfo
    ResolveApplicationMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveApplicationMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveApplicationMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveApplicationMethod "hasAction" o = Gio.ActionGroup.ActionGroupHasActionMethodInfo
    ResolveApplicationMethod "hold" o = Gio.Application.ApplicationHoldMethodInfo
    ResolveApplicationMethod "inhibit" o = Gtk.Application.ApplicationInhibitMethodInfo
    ResolveApplicationMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveApplicationMethod "listActionDescriptions" o = Gtk.Application.ApplicationListActionDescriptionsMethodInfo
    ResolveApplicationMethod "listActions" o = Gio.ActionGroup.ActionGroupListActionsMethodInfo
    ResolveApplicationMethod "lookupAction" o = Gio.ActionMap.ActionMapLookupActionMethodInfo
    ResolveApplicationMethod "markBusy" o = Gio.Application.ApplicationMarkBusyMethodInfo
    ResolveApplicationMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveApplicationMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveApplicationMethod "open" o = Gio.Application.ApplicationOpenMethodInfo
    ResolveApplicationMethod "queryAction" o = Gio.ActionGroup.ActionGroupQueryActionMethodInfo
    ResolveApplicationMethod "quit" o = Gio.Application.ApplicationQuitMethodInfo
    ResolveApplicationMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveApplicationMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveApplicationMethod "register" o = Gio.Application.ApplicationRegisterMethodInfo
    ResolveApplicationMethod "release" o = Gio.Application.ApplicationReleaseMethodInfo
    ResolveApplicationMethod "removeAction" o = Gio.ActionMap.ActionMapRemoveActionMethodInfo
    ResolveApplicationMethod "removeWindow" o = Gtk.Application.ApplicationRemoveWindowMethodInfo
    ResolveApplicationMethod "run" o = Gio.Application.ApplicationRunMethodInfo
    ResolveApplicationMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveApplicationMethod "sendNotification" o = Gio.Application.ApplicationSendNotificationMethodInfo
    ResolveApplicationMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveApplicationMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveApplicationMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveApplicationMethod "unbindBusyProperty" o = Gio.Application.ApplicationUnbindBusyPropertyMethodInfo
    ResolveApplicationMethod "uninhibit" o = Gtk.Application.ApplicationUninhibitMethodInfo
    ResolveApplicationMethod "unmarkBusy" o = Gio.Application.ApplicationUnmarkBusyMethodInfo
    ResolveApplicationMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveApplicationMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveApplicationMethod "withdrawNotification" o = Gio.Application.ApplicationWithdrawNotificationMethodInfo
    ResolveApplicationMethod "getAccelsForAction" o = Gtk.Application.ApplicationGetAccelsForActionMethodInfo
    ResolveApplicationMethod "getActionEnabled" o = Gio.ActionGroup.ActionGroupGetActionEnabledMethodInfo
    ResolveApplicationMethod "getActionParameterType" o = Gio.ActionGroup.ActionGroupGetActionParameterTypeMethodInfo
    ResolveApplicationMethod "getActionState" o = Gio.ActionGroup.ActionGroupGetActionStateMethodInfo
    ResolveApplicationMethod "getActionStateHint" o = Gio.ActionGroup.ActionGroupGetActionStateHintMethodInfo
    ResolveApplicationMethod "getActionStateType" o = Gio.ActionGroup.ActionGroupGetActionStateTypeMethodInfo
    ResolveApplicationMethod "getActionsForAccel" o = Gtk.Application.ApplicationGetActionsForAccelMethodInfo
    ResolveApplicationMethod "getActiveWindow" o = Gtk.Application.ApplicationGetActiveWindowMethodInfo
    ResolveApplicationMethod "getApplicationId" o = Gio.Application.ApplicationGetApplicationIdMethodInfo
    ResolveApplicationMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveApplicationMethod "getDbusConnection" o = Gio.Application.ApplicationGetDbusConnectionMethodInfo
    ResolveApplicationMethod "getDbusObjectPath" o = Gio.Application.ApplicationGetDbusObjectPathMethodInfo
    ResolveApplicationMethod "getFlags" o = Gio.Application.ApplicationGetFlagsMethodInfo
    ResolveApplicationMethod "getInactivityTimeout" o = Gio.Application.ApplicationGetInactivityTimeoutMethodInfo
    ResolveApplicationMethod "getIsBusy" o = Gio.Application.ApplicationGetIsBusyMethodInfo
    ResolveApplicationMethod "getIsRegistered" o = Gio.Application.ApplicationGetIsRegisteredMethodInfo
    ResolveApplicationMethod "getIsRemote" o = Gio.Application.ApplicationGetIsRemoteMethodInfo
    ResolveApplicationMethod "getMenuById" o = Gtk.Application.ApplicationGetMenuByIdMethodInfo
    ResolveApplicationMethod "getMenubar" o = Gtk.Application.ApplicationGetMenubarMethodInfo
    ResolveApplicationMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveApplicationMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveApplicationMethod "getResourceBasePath" o = Gio.Application.ApplicationGetResourceBasePathMethodInfo
    ResolveApplicationMethod "getStyleManager" o = ApplicationGetStyleManagerMethodInfo
    ResolveApplicationMethod "getWindowById" o = Gtk.Application.ApplicationGetWindowByIdMethodInfo
    ResolveApplicationMethod "getWindows" o = Gtk.Application.ApplicationGetWindowsMethodInfo
    ResolveApplicationMethod "setAccelsForAction" o = Gtk.Application.ApplicationSetAccelsForActionMethodInfo
    ResolveApplicationMethod "setActionGroup" o = Gio.Application.ApplicationSetActionGroupMethodInfo
    ResolveApplicationMethod "setApplicationId" o = Gio.Application.ApplicationSetApplicationIdMethodInfo
    ResolveApplicationMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveApplicationMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveApplicationMethod "setDefault" o = Gio.Application.ApplicationSetDefaultMethodInfo
    ResolveApplicationMethod "setFlags" o = Gio.Application.ApplicationSetFlagsMethodInfo
    ResolveApplicationMethod "setInactivityTimeout" o = Gio.Application.ApplicationSetInactivityTimeoutMethodInfo
    ResolveApplicationMethod "setMenubar" o = Gtk.Application.ApplicationSetMenubarMethodInfo
    ResolveApplicationMethod "setOptionContextDescription" o = Gio.Application.ApplicationSetOptionContextDescriptionMethodInfo
    ResolveApplicationMethod "setOptionContextParameterString" o = Gio.Application.ApplicationSetOptionContextParameterStringMethodInfo
    ResolveApplicationMethod "setOptionContextSummary" o = Gio.Application.ApplicationSetOptionContextSummaryMethodInfo
    ResolveApplicationMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveApplicationMethod "setResourceBasePath" o = Gio.Application.ApplicationSetResourceBasePathMethodInfo
    ResolveApplicationMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "style-manager"
   -- Type: TInterface (Name {namespace = "Adw", name = "StyleManager"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@style-manager@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' application #styleManager
-- @
getApplicationStyleManager :: (MonadIO m, IsApplication o) => o -> m Adw.StyleManager.StyleManager
getApplicationStyleManager :: forall (m :: * -> *) o.
(MonadIO m, IsApplication o) =>
o -> m StyleManager
getApplicationStyleManager o
obj = 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)
-> IO StyleManager -> m StyleManager
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe StyleManager) -> IO StyleManager
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getApplicationStyleManager" (IO (Maybe StyleManager) -> IO StyleManager)
-> IO (Maybe StyleManager) -> IO StyleManager
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (ManagedPtr StyleManager -> StyleManager)
-> IO (Maybe StyleManager)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"style-manager" ManagedPtr StyleManager -> StyleManager
Adw.StyleManager.StyleManager

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Application
type instance O.AttributeList Application = ApplicationAttributeList
type ApplicationAttributeList = ('[ '("actionGroup", Gio.Application.ApplicationActionGroupPropertyInfo), '("activeWindow", Gtk.Application.ApplicationActiveWindowPropertyInfo), '("applicationId", Gio.Application.ApplicationApplicationIdPropertyInfo), '("flags", Gio.Application.ApplicationFlagsPropertyInfo), '("inactivityTimeout", Gio.Application.ApplicationInactivityTimeoutPropertyInfo), '("isBusy", Gio.Application.ApplicationIsBusyPropertyInfo), '("isRegistered", Gio.Application.ApplicationIsRegisteredPropertyInfo), '("isRemote", Gio.Application.ApplicationIsRemotePropertyInfo), '("menubar", Gtk.Application.ApplicationMenubarPropertyInfo), '("registerSession", Gtk.Application.ApplicationRegisterSessionPropertyInfo), '("resourceBasePath", Gio.Application.ApplicationResourceBasePathPropertyInfo), '("screensaverActive", Gtk.Application.ApplicationScreensaverActivePropertyInfo), '("styleManager", ApplicationStyleManagerPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
applicationStyleManager :: AttrLabelProxy "styleManager"
applicationStyleManager = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Application = ApplicationSignalList
type ApplicationSignalList = ('[ '("actionAdded", Gio.ActionGroup.ActionGroupActionAddedSignalInfo), '("actionEnabledChanged", Gio.ActionGroup.ActionGroupActionEnabledChangedSignalInfo), '("actionRemoved", Gio.ActionGroup.ActionGroupActionRemovedSignalInfo), '("actionStateChanged", Gio.ActionGroup.ActionGroupActionStateChangedSignalInfo), '("activate", Gio.Application.ApplicationActivateSignalInfo), '("commandLine", Gio.Application.ApplicationCommandLineSignalInfo), '("handleLocalOptions", Gio.Application.ApplicationHandleLocalOptionsSignalInfo), '("nameLost", Gio.Application.ApplicationNameLostSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("open", Gio.Application.ApplicationOpenSignalInfo), '("queryEnd", Gtk.Application.ApplicationQueryEndSignalInfo), '("shutdown", Gio.Application.ApplicationShutdownSignalInfo), '("startup", Gio.Application.ApplicationStartupSignalInfo), '("windowAdded", Gtk.Application.ApplicationWindowAddedSignalInfo), '("windowRemoved", Gtk.Application.ApplicationWindowRemovedSignalInfo)] :: [(Symbol, *)])

#endif

-- method Application::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "application_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The application ID" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "ApplicationFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The application flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Adw" , name = "Application" })
-- throws : False
-- Skip return : False

foreign import ccall "adw_application_new" adw_application_new :: 
    CString ->                              -- application_id : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "ApplicationFlags"})
    IO (Ptr Application)

-- | Creates a new @AdwApplication@.
-- 
-- If @application_id@ is not @NULL@, then it must be valid. See
-- [func/@gio@/.Application.id_is_valid].
-- 
-- If no application ID is given then some features (most notably application
-- uniqueness) will be disabled.
-- 
-- /Since: 1.0/
applicationNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Maybe (T.Text)
    -- ^ /@applicationId@/: The application ID
    -> [Gio.Flags.ApplicationFlags]
    -- ^ /@flags@/: The application flags
    -> m Application
    -- ^ __Returns:__ the newly created @AdwApplication@
applicationNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> [ApplicationFlags] -> m Application
applicationNew Maybe Text
applicationId [ApplicationFlags]
flags = IO Application -> m Application
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Application -> m Application)
-> IO Application -> m Application
forall a b. (a -> b) -> a -> b
$ do
    Ptr CChar
maybeApplicationId <- case Maybe Text
applicationId of
        Maybe Text
Nothing -> Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just Text
jApplicationId -> do
            Ptr CChar
jApplicationId' <- Text -> IO (Ptr CChar)
textToCString Text
jApplicationId
            Ptr CChar -> IO (Ptr CChar)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jApplicationId'
    let flags' :: CUInt
flags' = [ApplicationFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [ApplicationFlags]
flags
    Ptr Application
result <- Ptr CChar -> CUInt -> IO (Ptr Application)
adw_application_new Ptr CChar
maybeApplicationId CUInt
flags'
    Text -> Ptr Application -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"applicationNew" Ptr Application
result
    Application
result' <- ((ManagedPtr Application -> Application)
-> Ptr Application -> IO Application
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Application -> Application
Application) Ptr Application
result
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeApplicationId
    Application -> IO Application
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Application
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Application::get_style_manager
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Adw" , name = "Application" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an application" , 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_application_get_style_manager" adw_application_get_style_manager :: 
    Ptr Application ->                      -- self : TInterface (Name {namespace = "Adw", name = "Application"})
    IO (Ptr Adw.StyleManager.StyleManager)

-- | Gets the style manager for /@self@/.
-- 
-- This is a convenience property allowing to access @AdwStyleManager@ through
-- property bindings or expressions.
-- 
-- /Since: 1.0/
applicationGetStyleManager ::
    (B.CallStack.HasCallStack, MonadIO m, IsApplication a) =>
    a
    -- ^ /@self@/: an application
    -> m Adw.StyleManager.StyleManager
    -- ^ __Returns:__ the style manager
applicationGetStyleManager :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsApplication a) =>
a -> m StyleManager
applicationGetStyleManager a
self = 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 Application
self' <- a -> IO (Ptr Application)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr StyleManager
result <- Ptr Application -> IO (Ptr StyleManager)
adw_application_get_style_manager Ptr Application
self'
    Text -> Ptr StyleManager -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"applicationGetStyleManager" 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
Adw.StyleManager.StyleManager) Ptr StyleManager
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    StyleManager -> IO StyleManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return StyleManager
result'

#if defined(ENABLE_OVERLOADING)
data ApplicationGetStyleManagerMethodInfo
instance (signature ~ (m Adw.StyleManager.StyleManager), MonadIO m, IsApplication a) => O.OverloadedMethod ApplicationGetStyleManagerMethodInfo a signature where
    overloadedMethod = applicationGetStyleManager

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


#endif