{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)
-}

module GI.Gio.Objects.Application
    ( 

-- * Exported types
    Application(..)                         ,
    ApplicationK                            ,
    toApplication                           ,
    noApplication                           ,


 -- * Methods
-- ** applicationActivate
    applicationActivate                     ,


-- ** applicationAddMainOption
    applicationAddMainOption                ,


-- ** applicationAddMainOptionEntries
    applicationAddMainOptionEntries         ,


-- ** applicationAddOptionGroup
    applicationAddOptionGroup               ,


-- ** applicationBindBusyProperty
    applicationBindBusyProperty             ,


-- ** applicationGetApplicationId
    applicationGetApplicationId             ,


-- ** applicationGetDbusConnection
    applicationGetDbusConnection            ,


-- ** applicationGetDbusObjectPath
    applicationGetDbusObjectPath            ,


-- ** applicationGetDefault
    applicationGetDefault                   ,


-- ** applicationGetFlags
    applicationGetFlags                     ,


-- ** applicationGetInactivityTimeout
    applicationGetInactivityTimeout         ,


-- ** applicationGetIsBusy
    applicationGetIsBusy                    ,


-- ** applicationGetIsRegistered
    applicationGetIsRegistered              ,


-- ** applicationGetIsRemote
    applicationGetIsRemote                  ,


-- ** applicationGetResourceBasePath
    applicationGetResourceBasePath          ,


-- ** applicationHold
    applicationHold                         ,


-- ** applicationIdIsValid
    applicationIdIsValid                    ,


-- ** applicationMarkBusy
    applicationMarkBusy                     ,


-- ** applicationNew
    applicationNew                          ,


-- ** applicationOpen
    applicationOpen                         ,


-- ** applicationQuit
    applicationQuit                         ,


-- ** applicationRegister
    applicationRegister                     ,


-- ** applicationRelease
    applicationRelease                      ,


-- ** applicationRun
    applicationRun                          ,


-- ** applicationSendNotification
    applicationSendNotification             ,


-- ** applicationSetActionGroup
    applicationSetActionGroup               ,


-- ** applicationSetApplicationId
    applicationSetApplicationId             ,


-- ** applicationSetDefault
    applicationSetDefault                   ,


-- ** applicationSetFlags
    applicationSetFlags                     ,


-- ** applicationSetInactivityTimeout
    applicationSetInactivityTimeout         ,


-- ** applicationSetResourceBasePath
    applicationSetResourceBasePath          ,


-- ** applicationUnbindBusyProperty
    applicationUnbindBusyProperty           ,


-- ** applicationUnmarkBusy
    applicationUnmarkBusy                   ,


-- ** applicationWithdrawNotification
    applicationWithdrawNotification         ,




 -- * Properties
-- ** ActionGroup
    ApplicationActionGroupPropertyInfo      ,
    constructApplicationActionGroup         ,
    setApplicationActionGroup               ,


-- ** ApplicationId
    ApplicationApplicationIdPropertyInfo    ,
    constructApplicationApplicationId       ,
    getApplicationApplicationId             ,
    setApplicationApplicationId             ,


-- ** Flags
    ApplicationFlagsPropertyInfo            ,
    constructApplicationFlags               ,
    getApplicationFlags                     ,
    setApplicationFlags                     ,


-- ** InactivityTimeout
    ApplicationInactivityTimeoutPropertyInfo,
    constructApplicationInactivityTimeout   ,
    getApplicationInactivityTimeout         ,
    setApplicationInactivityTimeout         ,


-- ** IsBusy
    ApplicationIsBusyPropertyInfo           ,
    getApplicationIsBusy                    ,


-- ** IsRegistered
    ApplicationIsRegisteredPropertyInfo     ,
    getApplicationIsRegistered              ,


-- ** IsRemote
    ApplicationIsRemotePropertyInfo         ,
    getApplicationIsRemote                  ,


-- ** ResourceBasePath
    ApplicationResourceBasePathPropertyInfo ,
    constructApplicationResourceBasePath    ,
    getApplicationResourceBasePath          ,
    setApplicationResourceBasePath          ,




 -- * Signals
-- ** Activate
    ApplicationActivateCallback             ,
    ApplicationActivateCallbackC            ,
    ApplicationActivateSignalInfo           ,
    afterApplicationActivate                ,
    applicationActivateCallbackWrapper      ,
    applicationActivateClosure              ,
    mkApplicationActivateCallback           ,
    noApplicationActivateCallback           ,
    onApplicationActivate                   ,


-- ** CommandLine
    ApplicationCommandLineCallback          ,
    ApplicationCommandLineCallbackC         ,
    ApplicationCommandLineSignalInfo        ,
    afterApplicationCommandLine             ,
    applicationCommandLineCallbackWrapper   ,
    applicationCommandLineClosure           ,
    mkApplicationCommandLineCallback        ,
    noApplicationCommandLineCallback        ,
    onApplicationCommandLine                ,


-- ** HandleLocalOptions
    ApplicationHandleLocalOptionsCallback   ,
    ApplicationHandleLocalOptionsCallbackC  ,
    ApplicationHandleLocalOptionsSignalInfo ,
    afterApplicationHandleLocalOptions      ,
    applicationHandleLocalOptionsCallbackWrapper,
    applicationHandleLocalOptionsClosure    ,
    mkApplicationHandleLocalOptionsCallback ,
    noApplicationHandleLocalOptionsCallback ,
    onApplicationHandleLocalOptions         ,


-- ** Open
    ApplicationOpenCallback                 ,
    ApplicationOpenCallbackC                ,
    ApplicationOpenSignalInfo               ,
    afterApplicationOpen                    ,
    applicationOpenCallbackWrapper          ,
    applicationOpenClosure                  ,
    mkApplicationOpenCallback               ,
    noApplicationOpenCallback               ,
    onApplicationOpen                       ,


-- ** Shutdown
    ApplicationShutdownCallback             ,
    ApplicationShutdownCallbackC            ,
    ApplicationShutdownSignalInfo           ,
    afterApplicationShutdown                ,
    applicationShutdownCallbackWrapper      ,
    applicationShutdownClosure              ,
    mkApplicationShutdownCallback           ,
    noApplicationShutdownCallback           ,
    onApplicationShutdown                   ,


-- ** Startup
    ApplicationStartupCallback              ,
    ApplicationStartupCallbackC             ,
    ApplicationStartupSignalInfo            ,
    afterApplicationStartup                 ,
    applicationStartupCallbackWrapper       ,
    applicationStartupClosure               ,
    mkApplicationStartupCallback            ,
    noApplicationStartupCallback            ,
    onApplicationStartup                    ,




    ) where

import Prelude ()
import Data.GI.Base.ShortPrelude

import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map

import GI.Gio.Types
import GI.Gio.Callbacks
import qualified GI.GLib as GLib
import qualified GI.GObject as GObject

newtype Application = Application (ForeignPtr Application)
foreign import ccall "g_application_get_type"
    c_g_application_get_type :: IO GType

type instance ParentTypes Application = ApplicationParentTypes
type ApplicationParentTypes = '[GObject.Object, ActionGroup, ActionMap]

instance GObject Application where
    gobjectIsInitiallyUnowned _ = False
    gobjectType _ = c_g_application_get_type
    

class GObject o => ApplicationK o
instance (GObject o, IsDescendantOf Application o) => ApplicationK o

toApplication :: ApplicationK o => o -> IO Application
toApplication = unsafeCastTo Application

noApplication :: Maybe Application
noApplication = Nothing

-- signal Application::activate
type ApplicationActivateCallback =
    IO ()

noApplicationActivateCallback :: Maybe ApplicationActivateCallback
noApplicationActivateCallback = Nothing

type ApplicationActivateCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkApplicationActivateCallback :: ApplicationActivateCallbackC -> IO (FunPtr ApplicationActivateCallbackC)

applicationActivateClosure :: ApplicationActivateCallback -> IO Closure
applicationActivateClosure cb = newCClosure =<< mkApplicationActivateCallback wrapped
    where wrapped = applicationActivateCallbackWrapper cb

applicationActivateCallbackWrapper ::
    ApplicationActivateCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
applicationActivateCallbackWrapper _cb _ _ = do
    _cb 

onApplicationActivate :: (GObject a, MonadIO m) => a -> ApplicationActivateCallback -> m SignalHandlerId
onApplicationActivate obj cb = liftIO $ connectApplicationActivate obj cb SignalConnectBefore
afterApplicationActivate :: (GObject a, MonadIO m) => a -> ApplicationActivateCallback -> m SignalHandlerId
afterApplicationActivate obj cb = connectApplicationActivate obj cb SignalConnectAfter

connectApplicationActivate :: (GObject a, MonadIO m) =>
                              a -> ApplicationActivateCallback -> SignalConnectMode -> m SignalHandlerId
connectApplicationActivate obj cb after = liftIO $ do
    cb' <- mkApplicationActivateCallback (applicationActivateCallbackWrapper cb)
    connectSignalFunPtr obj "activate" cb' after

-- signal Application::command-line
type ApplicationCommandLineCallback =
    ApplicationCommandLine ->
    IO Int32

noApplicationCommandLineCallback :: Maybe ApplicationCommandLineCallback
noApplicationCommandLineCallback = Nothing

type ApplicationCommandLineCallbackC =
    Ptr () ->                               -- object
    Ptr ApplicationCommandLine ->
    Ptr () ->                               -- user_data
    IO Int32

foreign import ccall "wrapper"
    mkApplicationCommandLineCallback :: ApplicationCommandLineCallbackC -> IO (FunPtr ApplicationCommandLineCallbackC)

applicationCommandLineClosure :: ApplicationCommandLineCallback -> IO Closure
applicationCommandLineClosure cb = newCClosure =<< mkApplicationCommandLineCallback wrapped
    where wrapped = applicationCommandLineCallbackWrapper cb

applicationCommandLineCallbackWrapper ::
    ApplicationCommandLineCallback ->
    Ptr () ->
    Ptr ApplicationCommandLine ->
    Ptr () ->
    IO Int32
applicationCommandLineCallbackWrapper _cb _ command_line _ = do
    command_line' <- (newObject ApplicationCommandLine) command_line
    result <- _cb  command_line'
    return result

onApplicationCommandLine :: (GObject a, MonadIO m) => a -> ApplicationCommandLineCallback -> m SignalHandlerId
onApplicationCommandLine obj cb = liftIO $ connectApplicationCommandLine obj cb SignalConnectBefore
afterApplicationCommandLine :: (GObject a, MonadIO m) => a -> ApplicationCommandLineCallback -> m SignalHandlerId
afterApplicationCommandLine obj cb = connectApplicationCommandLine obj cb SignalConnectAfter

connectApplicationCommandLine :: (GObject a, MonadIO m) =>
                                 a -> ApplicationCommandLineCallback -> SignalConnectMode -> m SignalHandlerId
connectApplicationCommandLine obj cb after = liftIO $ do
    cb' <- mkApplicationCommandLineCallback (applicationCommandLineCallbackWrapper cb)
    connectSignalFunPtr obj "command-line" cb' after

-- signal Application::handle-local-options
type ApplicationHandleLocalOptionsCallback =
    GLib.VariantDict ->
    IO Int32

noApplicationHandleLocalOptionsCallback :: Maybe ApplicationHandleLocalOptionsCallback
noApplicationHandleLocalOptionsCallback = Nothing

type ApplicationHandleLocalOptionsCallbackC =
    Ptr () ->                               -- object
    Ptr GLib.VariantDict ->
    Ptr () ->                               -- user_data
    IO Int32

foreign import ccall "wrapper"
    mkApplicationHandleLocalOptionsCallback :: ApplicationHandleLocalOptionsCallbackC -> IO (FunPtr ApplicationHandleLocalOptionsCallbackC)

applicationHandleLocalOptionsClosure :: ApplicationHandleLocalOptionsCallback -> IO Closure
applicationHandleLocalOptionsClosure cb = newCClosure =<< mkApplicationHandleLocalOptionsCallback wrapped
    where wrapped = applicationHandleLocalOptionsCallbackWrapper cb

applicationHandleLocalOptionsCallbackWrapper ::
    ApplicationHandleLocalOptionsCallback ->
    Ptr () ->
    Ptr GLib.VariantDict ->
    Ptr () ->
    IO Int32
applicationHandleLocalOptionsCallbackWrapper _cb _ options _ = do
    options' <- (newBoxed GLib.VariantDict) options
    result <- _cb  options'
    return result

onApplicationHandleLocalOptions :: (GObject a, MonadIO m) => a -> ApplicationHandleLocalOptionsCallback -> m SignalHandlerId
onApplicationHandleLocalOptions obj cb = liftIO $ connectApplicationHandleLocalOptions obj cb SignalConnectBefore
afterApplicationHandleLocalOptions :: (GObject a, MonadIO m) => a -> ApplicationHandleLocalOptionsCallback -> m SignalHandlerId
afterApplicationHandleLocalOptions obj cb = connectApplicationHandleLocalOptions obj cb SignalConnectAfter

connectApplicationHandleLocalOptions :: (GObject a, MonadIO m) =>
                                        a -> ApplicationHandleLocalOptionsCallback -> SignalConnectMode -> m SignalHandlerId
connectApplicationHandleLocalOptions obj cb after = liftIO $ do
    cb' <- mkApplicationHandleLocalOptionsCallback (applicationHandleLocalOptionsCallbackWrapper cb)
    connectSignalFunPtr obj "handle-local-options" cb' after

-- signal Application::open
type ApplicationOpenCallback =
    [File] ->
    T.Text ->
    IO ()

noApplicationOpenCallback :: Maybe ApplicationOpenCallback
noApplicationOpenCallback = Nothing

type ApplicationOpenCallbackC =
    Ptr () ->                               -- object
    Ptr (Ptr File) ->
    Int32 ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkApplicationOpenCallback :: ApplicationOpenCallbackC -> IO (FunPtr ApplicationOpenCallbackC)

applicationOpenClosure :: ApplicationOpenCallback -> IO Closure
applicationOpenClosure cb = newCClosure =<< mkApplicationOpenCallback wrapped
    where wrapped = applicationOpenCallbackWrapper cb

applicationOpenCallbackWrapper ::
    ApplicationOpenCallback ->
    Ptr () ->
    Ptr (Ptr File) ->
    Int32 ->
    CString ->
    Ptr () ->
    IO ()
applicationOpenCallbackWrapper _cb _ files n_files hint _ = do
    files' <- (unpackPtrArrayWithLength n_files) files
    files'' <- mapM (newObject File) files'
    hint' <- cstringToText hint
    _cb  files'' hint'

onApplicationOpen :: (GObject a, MonadIO m) => a -> ApplicationOpenCallback -> m SignalHandlerId
onApplicationOpen obj cb = liftIO $ connectApplicationOpen obj cb SignalConnectBefore
afterApplicationOpen :: (GObject a, MonadIO m) => a -> ApplicationOpenCallback -> m SignalHandlerId
afterApplicationOpen obj cb = connectApplicationOpen obj cb SignalConnectAfter

connectApplicationOpen :: (GObject a, MonadIO m) =>
                          a -> ApplicationOpenCallback -> SignalConnectMode -> m SignalHandlerId
connectApplicationOpen obj cb after = liftIO $ do
    cb' <- mkApplicationOpenCallback (applicationOpenCallbackWrapper cb)
    connectSignalFunPtr obj "open" cb' after

-- signal Application::shutdown
type ApplicationShutdownCallback =
    IO ()

noApplicationShutdownCallback :: Maybe ApplicationShutdownCallback
noApplicationShutdownCallback = Nothing

type ApplicationShutdownCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkApplicationShutdownCallback :: ApplicationShutdownCallbackC -> IO (FunPtr ApplicationShutdownCallbackC)

applicationShutdownClosure :: ApplicationShutdownCallback -> IO Closure
applicationShutdownClosure cb = newCClosure =<< mkApplicationShutdownCallback wrapped
    where wrapped = applicationShutdownCallbackWrapper cb

applicationShutdownCallbackWrapper ::
    ApplicationShutdownCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
applicationShutdownCallbackWrapper _cb _ _ = do
    _cb 

onApplicationShutdown :: (GObject a, MonadIO m) => a -> ApplicationShutdownCallback -> m SignalHandlerId
onApplicationShutdown obj cb = liftIO $ connectApplicationShutdown obj cb SignalConnectBefore
afterApplicationShutdown :: (GObject a, MonadIO m) => a -> ApplicationShutdownCallback -> m SignalHandlerId
afterApplicationShutdown obj cb = connectApplicationShutdown obj cb SignalConnectAfter

connectApplicationShutdown :: (GObject a, MonadIO m) =>
                              a -> ApplicationShutdownCallback -> SignalConnectMode -> m SignalHandlerId
connectApplicationShutdown obj cb after = liftIO $ do
    cb' <- mkApplicationShutdownCallback (applicationShutdownCallbackWrapper cb)
    connectSignalFunPtr obj "shutdown" cb' after

-- signal Application::startup
type ApplicationStartupCallback =
    IO ()

noApplicationStartupCallback :: Maybe ApplicationStartupCallback
noApplicationStartupCallback = Nothing

type ApplicationStartupCallbackC =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

foreign import ccall "wrapper"
    mkApplicationStartupCallback :: ApplicationStartupCallbackC -> IO (FunPtr ApplicationStartupCallbackC)

applicationStartupClosure :: ApplicationStartupCallback -> IO Closure
applicationStartupClosure cb = newCClosure =<< mkApplicationStartupCallback wrapped
    where wrapped = applicationStartupCallbackWrapper cb

applicationStartupCallbackWrapper ::
    ApplicationStartupCallback ->
    Ptr () ->
    Ptr () ->
    IO ()
applicationStartupCallbackWrapper _cb _ _ = do
    _cb 

onApplicationStartup :: (GObject a, MonadIO m) => a -> ApplicationStartupCallback -> m SignalHandlerId
onApplicationStartup obj cb = liftIO $ connectApplicationStartup obj cb SignalConnectBefore
afterApplicationStartup :: (GObject a, MonadIO m) => a -> ApplicationStartupCallback -> m SignalHandlerId
afterApplicationStartup obj cb = connectApplicationStartup obj cb SignalConnectAfter

connectApplicationStartup :: (GObject a, MonadIO m) =>
                             a -> ApplicationStartupCallback -> SignalConnectMode -> m SignalHandlerId
connectApplicationStartup obj cb after = liftIO $ do
    cb' <- mkApplicationStartupCallback (applicationStartupCallbackWrapper cb)
    connectSignalFunPtr obj "startup" cb' after

-- VVV Prop "action-group"
   -- Type: TInterface "Gio" "ActionGroup"
   -- Flags: [PropertyWritable]

setApplicationActionGroup :: (MonadIO m, ApplicationK o, ActionGroupK a) => o -> a -> m ()
setApplicationActionGroup obj val = liftIO $ setObjectPropertyObject obj "action-group" val

constructApplicationActionGroup :: (ActionGroupK a) => a -> IO ([Char], GValue)
constructApplicationActionGroup val = constructObjectPropertyObject "action-group" val

data ApplicationActionGroupPropertyInfo
instance AttrInfo ApplicationActionGroupPropertyInfo where
    type AttrAllowedOps ApplicationActionGroupPropertyInfo = '[ 'AttrSet, 'AttrConstruct]
    type AttrSetTypeConstraint ApplicationActionGroupPropertyInfo = ActionGroupK
    type AttrBaseTypeConstraint ApplicationActionGroupPropertyInfo = ApplicationK
    type AttrGetType ApplicationActionGroupPropertyInfo = ()
    type AttrLabel ApplicationActionGroupPropertyInfo = "Application::action-group"
    attrGet _ = undefined
    attrSet _ = setApplicationActionGroup
    attrConstruct _ = constructApplicationActionGroup

-- VVV Prop "application-id"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstruct]

getApplicationApplicationId :: (MonadIO m, ApplicationK o) => o -> m T.Text
getApplicationApplicationId obj = liftIO $ getObjectPropertyString obj "application-id"

setApplicationApplicationId :: (MonadIO m, ApplicationK o) => o -> T.Text -> m ()
setApplicationApplicationId obj val = liftIO $ setObjectPropertyString obj "application-id" val

constructApplicationApplicationId :: T.Text -> IO ([Char], GValue)
constructApplicationApplicationId val = constructObjectPropertyString "application-id" val

data ApplicationApplicationIdPropertyInfo
instance AttrInfo ApplicationApplicationIdPropertyInfo where
    type AttrAllowedOps ApplicationApplicationIdPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ApplicationApplicationIdPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint ApplicationApplicationIdPropertyInfo = ApplicationK
    type AttrGetType ApplicationApplicationIdPropertyInfo = T.Text
    type AttrLabel ApplicationApplicationIdPropertyInfo = "Application::application-id"
    attrGet _ = getApplicationApplicationId
    attrSet _ = setApplicationApplicationId
    attrConstruct _ = constructApplicationApplicationId

-- VVV Prop "flags"
   -- Type: TInterface "Gio" "ApplicationFlags"
   -- Flags: [PropertyReadable,PropertyWritable]

getApplicationFlags :: (MonadIO m, ApplicationK o) => o -> m [ApplicationFlags]
getApplicationFlags obj = liftIO $ getObjectPropertyFlags obj "flags"

setApplicationFlags :: (MonadIO m, ApplicationK o) => o -> [ApplicationFlags] -> m ()
setApplicationFlags obj val = liftIO $ setObjectPropertyFlags obj "flags" val

constructApplicationFlags :: [ApplicationFlags] -> IO ([Char], GValue)
constructApplicationFlags val = constructObjectPropertyFlags "flags" val

data ApplicationFlagsPropertyInfo
instance AttrInfo ApplicationFlagsPropertyInfo where
    type AttrAllowedOps ApplicationFlagsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ApplicationFlagsPropertyInfo = (~) [ApplicationFlags]
    type AttrBaseTypeConstraint ApplicationFlagsPropertyInfo = ApplicationK
    type AttrGetType ApplicationFlagsPropertyInfo = [ApplicationFlags]
    type AttrLabel ApplicationFlagsPropertyInfo = "Application::flags"
    attrGet _ = getApplicationFlags
    attrSet _ = setApplicationFlags
    attrConstruct _ = constructApplicationFlags

-- VVV Prop "inactivity-timeout"
   -- Type: TBasicType TUInt32
   -- Flags: [PropertyReadable,PropertyWritable]

getApplicationInactivityTimeout :: (MonadIO m, ApplicationK o) => o -> m Word32
getApplicationInactivityTimeout obj = liftIO $ getObjectPropertyCUInt obj "inactivity-timeout"

setApplicationInactivityTimeout :: (MonadIO m, ApplicationK o) => o -> Word32 -> m ()
setApplicationInactivityTimeout obj val = liftIO $ setObjectPropertyCUInt obj "inactivity-timeout" val

constructApplicationInactivityTimeout :: Word32 -> IO ([Char], GValue)
constructApplicationInactivityTimeout val = constructObjectPropertyCUInt "inactivity-timeout" val

data ApplicationInactivityTimeoutPropertyInfo
instance AttrInfo ApplicationInactivityTimeoutPropertyInfo where
    type AttrAllowedOps ApplicationInactivityTimeoutPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ApplicationInactivityTimeoutPropertyInfo = (~) Word32
    type AttrBaseTypeConstraint ApplicationInactivityTimeoutPropertyInfo = ApplicationK
    type AttrGetType ApplicationInactivityTimeoutPropertyInfo = Word32
    type AttrLabel ApplicationInactivityTimeoutPropertyInfo = "Application::inactivity-timeout"
    attrGet _ = getApplicationInactivityTimeout
    attrSet _ = setApplicationInactivityTimeout
    attrConstruct _ = constructApplicationInactivityTimeout

-- VVV Prop "is-busy"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]

getApplicationIsBusy :: (MonadIO m, ApplicationK o) => o -> m Bool
getApplicationIsBusy obj = liftIO $ getObjectPropertyBool obj "is-busy"

data ApplicationIsBusyPropertyInfo
instance AttrInfo ApplicationIsBusyPropertyInfo where
    type AttrAllowedOps ApplicationIsBusyPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ApplicationIsBusyPropertyInfo = (~) ()
    type AttrBaseTypeConstraint ApplicationIsBusyPropertyInfo = ApplicationK
    type AttrGetType ApplicationIsBusyPropertyInfo = Bool
    type AttrLabel ApplicationIsBusyPropertyInfo = "Application::is-busy"
    attrGet _ = getApplicationIsBusy
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "is-registered"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]

getApplicationIsRegistered :: (MonadIO m, ApplicationK o) => o -> m Bool
getApplicationIsRegistered obj = liftIO $ getObjectPropertyBool obj "is-registered"

data ApplicationIsRegisteredPropertyInfo
instance AttrInfo ApplicationIsRegisteredPropertyInfo where
    type AttrAllowedOps ApplicationIsRegisteredPropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ApplicationIsRegisteredPropertyInfo = (~) ()
    type AttrBaseTypeConstraint ApplicationIsRegisteredPropertyInfo = ApplicationK
    type AttrGetType ApplicationIsRegisteredPropertyInfo = Bool
    type AttrLabel ApplicationIsRegisteredPropertyInfo = "Application::is-registered"
    attrGet _ = getApplicationIsRegistered
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "is-remote"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]

getApplicationIsRemote :: (MonadIO m, ApplicationK o) => o -> m Bool
getApplicationIsRemote obj = liftIO $ getObjectPropertyBool obj "is-remote"

data ApplicationIsRemotePropertyInfo
instance AttrInfo ApplicationIsRemotePropertyInfo where
    type AttrAllowedOps ApplicationIsRemotePropertyInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint ApplicationIsRemotePropertyInfo = (~) ()
    type AttrBaseTypeConstraint ApplicationIsRemotePropertyInfo = ApplicationK
    type AttrGetType ApplicationIsRemotePropertyInfo = Bool
    type AttrLabel ApplicationIsRemotePropertyInfo = "Application::is-remote"
    attrGet _ = getApplicationIsRemote
    attrSet _ = undefined
    attrConstruct _ = undefined

-- VVV Prop "resource-base-path"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]

getApplicationResourceBasePath :: (MonadIO m, ApplicationK o) => o -> m T.Text
getApplicationResourceBasePath obj = liftIO $ getObjectPropertyString obj "resource-base-path"

setApplicationResourceBasePath :: (MonadIO m, ApplicationK o) => o -> T.Text -> m ()
setApplicationResourceBasePath obj val = liftIO $ setObjectPropertyString obj "resource-base-path" val

constructApplicationResourceBasePath :: T.Text -> IO ([Char], GValue)
constructApplicationResourceBasePath val = constructObjectPropertyString "resource-base-path" val

data ApplicationResourceBasePathPropertyInfo
instance AttrInfo ApplicationResourceBasePathPropertyInfo where
    type AttrAllowedOps ApplicationResourceBasePathPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrSetTypeConstraint ApplicationResourceBasePathPropertyInfo = (~) T.Text
    type AttrBaseTypeConstraint ApplicationResourceBasePathPropertyInfo = ApplicationK
    type AttrGetType ApplicationResourceBasePathPropertyInfo = T.Text
    type AttrLabel ApplicationResourceBasePathPropertyInfo = "Application::resource-base-path"
    attrGet _ = getApplicationResourceBasePath
    attrSet _ = setApplicationResourceBasePath
    attrConstruct _ = constructApplicationResourceBasePath

type instance AttributeList Application = ApplicationAttributeList
type ApplicationAttributeList = ('[ '("action-group", ApplicationActionGroupPropertyInfo), '("application-id", ApplicationApplicationIdPropertyInfo), '("flags", ApplicationFlagsPropertyInfo), '("inactivity-timeout", ApplicationInactivityTimeoutPropertyInfo), '("is-busy", ApplicationIsBusyPropertyInfo), '("is-registered", ApplicationIsRegisteredPropertyInfo), '("is-remote", ApplicationIsRemotePropertyInfo), '("resource-base-path", ApplicationResourceBasePathPropertyInfo)] :: [(Symbol, *)])

data ApplicationActivateSignalInfo
instance SignalInfo ApplicationActivateSignalInfo where
    type HaskellCallbackType ApplicationActivateSignalInfo = ApplicationActivateCallback
    connectSignal _ = connectApplicationActivate

data ApplicationCommandLineSignalInfo
instance SignalInfo ApplicationCommandLineSignalInfo where
    type HaskellCallbackType ApplicationCommandLineSignalInfo = ApplicationCommandLineCallback
    connectSignal _ = connectApplicationCommandLine

data ApplicationHandleLocalOptionsSignalInfo
instance SignalInfo ApplicationHandleLocalOptionsSignalInfo where
    type HaskellCallbackType ApplicationHandleLocalOptionsSignalInfo = ApplicationHandleLocalOptionsCallback
    connectSignal _ = connectApplicationHandleLocalOptions

data ApplicationOpenSignalInfo
instance SignalInfo ApplicationOpenSignalInfo where
    type HaskellCallbackType ApplicationOpenSignalInfo = ApplicationOpenCallback
    connectSignal _ = connectApplicationOpen

data ApplicationShutdownSignalInfo
instance SignalInfo ApplicationShutdownSignalInfo where
    type HaskellCallbackType ApplicationShutdownSignalInfo = ApplicationShutdownCallback
    connectSignal _ = connectApplicationShutdown

data ApplicationStartupSignalInfo
instance SignalInfo ApplicationStartupSignalInfo where
    type HaskellCallbackType ApplicationStartupSignalInfo = ApplicationStartupCallback
    connectSignal _ = connectApplicationStartup

type instance SignalList Application = ApplicationSignalList
type ApplicationSignalList = ('[ '("action-added", ActionGroupActionAddedSignalInfo), '("action-enabled-changed", ActionGroupActionEnabledChangedSignalInfo), '("action-removed", ActionGroupActionRemovedSignalInfo), '("action-state-changed", ActionGroupActionStateChangedSignalInfo), '("activate", ApplicationActivateSignalInfo), '("command-line", ApplicationCommandLineSignalInfo), '("handle-local-options", ApplicationHandleLocalOptionsSignalInfo), '("notify", GObject.ObjectNotifySignalInfo), '("open", ApplicationOpenSignalInfo), '("shutdown", ApplicationShutdownSignalInfo), '("startup", ApplicationStartupSignalInfo), '("notify::[property]", GObjectNotifySignalInfo)] :: [(Symbol, *)])

-- method Application::new
-- method type : Constructor
-- Args : [Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ApplicationFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ApplicationFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "Application"
-- throws : False
-- Skip return : False

foreign import ccall "g_application_new" g_application_new :: 
    CString ->                              -- application_id : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface "Gio" "ApplicationFlags"
    IO (Ptr Application)


applicationNew ::
    (MonadIO m) =>
    Maybe (T.Text) ->                       -- application_id
    [ApplicationFlags] ->                   -- flags
    m Application
applicationNew application_id flags = liftIO $ do
    maybeApplication_id <- case application_id of
        Nothing -> return nullPtr
        Just jApplication_id -> do
            jApplication_id' <- textToCString jApplication_id
            return jApplication_id'
    let flags' = gflagsToWord flags
    result <- g_application_new maybeApplication_id flags'
    checkUnexpectedReturnNULL "g_application_new" result
    result' <- (wrapObject Application) result
    freeMem maybeApplication_id
    return result'

-- method Application::activate
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_activate" g_application_activate :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO ()


applicationActivate ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m ()
applicationActivate _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_application_activate _obj'
    touchManagedPtr _obj
    return ()

-- method Application::add_main_option
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "long_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "short_name", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "OptionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg", argType = TInterface "GLib" "OptionArg", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg_description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "long_name", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "short_name", argType = TBasicType TInt8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "GLib" "OptionFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg", argType = TInterface "GLib" "OptionArg", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "arg_description", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_add_main_option" g_application_add_main_option :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    CString ->                              -- long_name : TBasicType TUTF8
    Int8 ->                                 -- short_name : TBasicType TInt8
    CUInt ->                                -- flags : TInterface "GLib" "OptionFlags"
    CUInt ->                                -- arg : TInterface "GLib" "OptionArg"
    CString ->                              -- description : TBasicType TUTF8
    CString ->                              -- arg_description : TBasicType TUTF8
    IO ()


applicationAddMainOption ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- long_name
    Int8 ->                                 -- short_name
    [GLib.OptionFlags] ->                   -- flags
    GLib.OptionArg ->                       -- arg
    T.Text ->                               -- description
    Maybe (T.Text) ->                       -- arg_description
    m ()
applicationAddMainOption _obj long_name short_name flags arg description arg_description = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    long_name' <- textToCString long_name
    let flags' = gflagsToWord flags
    let arg' = (fromIntegral . fromEnum) arg
    description' <- textToCString description
    maybeArg_description <- case arg_description of
        Nothing -> return nullPtr
        Just jArg_description -> do
            jArg_description' <- textToCString jArg_description
            return jArg_description'
    g_application_add_main_option _obj' long_name' short_name flags' arg' description' maybeArg_description
    touchManagedPtr _obj
    freeMem long_name'
    freeMem description'
    freeMem maybeArg_description
    return ()

-- method Application::add_main_option_entries
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TCArray True (-1) (-1) (TInterface "GLib" "OptionEntry"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "entries", argType = TCArray True (-1) (-1) (TInterface "GLib" "OptionEntry"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_add_main_option_entries" g_application_add_main_option_entries :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Ptr (Ptr GLib.OptionEntry) ->           -- entries : TCArray True (-1) (-1) (TInterface "GLib" "OptionEntry")
    IO ()


applicationAddMainOptionEntries ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    [GLib.OptionEntry] ->                   -- entries
    m ()
applicationAddMainOptionEntries _obj entries = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let entries' = map unsafeManagedPtrGetPtr entries
    entries'' <- packZeroTerminatedPtrArray entries'
    g_application_add_main_option_entries _obj' entries''
    touchManagedPtr _obj
    mapM_ touchManagedPtr entries
    freeMem entries''
    return ()

-- method Application::add_option_group
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "group", argType = TInterface "GLib" "OptionGroup", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_add_option_group" g_application_add_option_group :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Ptr GLib.OptionGroup ->                 -- group : TInterface "GLib" "OptionGroup"
    IO ()


applicationAddOptionGroup ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    GLib.OptionGroup ->                     -- group
    m ()
applicationAddOptionGroup _obj group = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let group' = unsafeManagedPtrGetPtr group
    g_application_add_option_group _obj' group'
    touchManagedPtr _obj
    touchManagedPtr group
    return ()

-- method Application::bind_busy_property
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_bind_busy_property" g_application_bind_busy_property :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Ptr GObject.Object ->                   -- object : TInterface "GObject" "Object"
    CString ->                              -- property : TBasicType TUTF8
    IO ()


applicationBindBusyProperty ::
    (MonadIO m, ApplicationK a, GObject.ObjectK b) =>
    a ->                                    -- _obj
    b ->                                    -- object
    T.Text ->                               -- property
    m ()
applicationBindBusyProperty _obj object property = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let object' = unsafeManagedPtrCastPtr object
    property' <- textToCString property
    g_application_bind_busy_property _obj' object' property'
    touchManagedPtr _obj
    touchManagedPtr object
    freeMem property'
    return ()

-- method Application::get_application_id
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_application_id" g_application_get_application_id :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO CString


applicationGetApplicationId ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m T.Text
applicationGetApplicationId _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_application_id _obj'
    checkUnexpectedReturnNULL "g_application_get_application_id" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method Application::get_dbus_connection
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "DBusConnection"
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_dbus_connection" g_application_get_dbus_connection :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO (Ptr DBusConnection)


applicationGetDbusConnection ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m DBusConnection
applicationGetDbusConnection _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_dbus_connection _obj'
    checkUnexpectedReturnNULL "g_application_get_dbus_connection" result
    result' <- (newObject DBusConnection) result
    touchManagedPtr _obj
    return result'

-- method Application::get_dbus_object_path
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_dbus_object_path" g_application_get_dbus_object_path :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO CString


applicationGetDbusObjectPath ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m T.Text
applicationGetDbusObjectPath _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_dbus_object_path _obj'
    checkUnexpectedReturnNULL "g_application_get_dbus_object_path" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method Application::get_flags
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TInterface "Gio" "ApplicationFlags"
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_flags" g_application_get_flags :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO CUInt


applicationGetFlags ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m [ApplicationFlags]
applicationGetFlags _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_flags _obj'
    let result' = wordToGFlags result
    touchManagedPtr _obj
    return result'

-- method Application::get_inactivity_timeout
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUInt32
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_inactivity_timeout" g_application_get_inactivity_timeout :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO Word32


applicationGetInactivityTimeout ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m Word32
applicationGetInactivityTimeout _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_inactivity_timeout _obj'
    touchManagedPtr _obj
    return result

-- method Application::get_is_busy
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_is_busy" g_application_get_is_busy :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO CInt


applicationGetIsBusy ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m Bool
applicationGetIsBusy _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_is_busy _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Application::get_is_registered
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_is_registered" g_application_get_is_registered :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO CInt


applicationGetIsRegistered ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m Bool
applicationGetIsRegistered _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_is_registered _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Application::get_is_remote
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_is_remote" g_application_get_is_remote :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO CInt


applicationGetIsRemote ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m Bool
applicationGetIsRemote _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_is_remote _obj'
    let result' = (/= 0) result
    touchManagedPtr _obj
    return result'

-- method Application::get_resource_base_path
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TUTF8
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_resource_base_path" g_application_get_resource_base_path :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO CString


applicationGetResourceBasePath ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m T.Text
applicationGetResourceBasePath _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    result <- g_application_get_resource_base_path _obj'
    checkUnexpectedReturnNULL "g_application_get_resource_base_path" result
    result' <- cstringToText result
    touchManagedPtr _obj
    return result'

-- method Application::hold
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_hold" g_application_hold :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO ()


applicationHold ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m ()
applicationHold _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_application_hold _obj'
    touchManagedPtr _obj
    return ()

-- method Application::mark_busy
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_mark_busy" g_application_mark_busy :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO ()


applicationMarkBusy ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m ()
applicationMarkBusy _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_application_mark_busy _obj'
    touchManagedPtr _obj
    return ()

-- method Application::open
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TCArray False (-1) 2 (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "n_files", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : [Arg {argName = "n_files", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "files", argType = TCArray False (-1) 2 (TInterface "Gio" "File"), direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "hint", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_open" g_application_open :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Ptr (Ptr File) ->                       -- files : TCArray False (-1) 2 (TInterface "Gio" "File")
    Int32 ->                                -- n_files : TBasicType TInt32
    CString ->                              -- hint : TBasicType TUTF8
    IO ()


applicationOpen ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    [File] ->                               -- files
    T.Text ->                               -- hint
    m ()
applicationOpen _obj files hint = liftIO $ do
    let n_files = fromIntegral $ length files
    let _obj' = unsafeManagedPtrCastPtr _obj
    let files' = map unsafeManagedPtrCastPtr files
    files'' <- packPtrArray files'
    hint' <- textToCString hint
    g_application_open _obj' files'' n_files hint'
    touchManagedPtr _obj
    mapM_ touchManagedPtr files
    freeMem files''
    freeMem hint'
    return ()

-- method Application::quit
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_quit" g_application_quit :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO ()


applicationQuit ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m ()
applicationQuit _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_application_quit _obj'
    touchManagedPtr _obj
    return ()

-- method Application::register
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "cancellable", argType = TInterface "Gio" "Cancellable", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : True
-- Skip return : False

foreign import ccall "g_application_register" g_application_register :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Ptr Cancellable ->                      -- cancellable : TInterface "Gio" "Cancellable"
    Ptr (Ptr GError) ->                     -- error
    IO CInt


applicationRegister ::
    (MonadIO m, ApplicationK a, CancellableK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- cancellable
    m ()
applicationRegister _obj cancellable = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeCancellable <- case cancellable of
        Nothing -> return nullPtr
        Just jCancellable -> do
            let jCancellable' = unsafeManagedPtrCastPtr jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ g_application_register _obj' maybeCancellable
        touchManagedPtr _obj
        whenJust cancellable touchManagedPtr
        return ()
     ) (do
        return ()
     )

-- method Application::release
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_release" g_application_release :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO ()


applicationRelease ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m ()
applicationRelease _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_application_release _obj'
    touchManagedPtr _obj
    return ()

-- method Application::run
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argc", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray False (-1) 1 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : [Arg {argName = "argc", argType = TBasicType TInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "argv", argType = TCArray False (-1) 1 (TBasicType TUTF8), direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TInt32
-- throws : False
-- Skip return : False

foreign import ccall "g_application_run" g_application_run :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Int32 ->                                -- argc : TBasicType TInt32
    Ptr CString ->                          -- argv : TCArray False (-1) 1 (TBasicType TUTF8)
    IO Int32


applicationRun ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    Maybe ([T.Text]) ->                     -- argv
    m Int32
applicationRun _obj argv = liftIO $ do
    let argc = case argv of
            Nothing -> 0
            Just jArgv -> fromIntegral $ length jArgv
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeArgv <- case argv of
        Nothing -> return nullPtr
        Just jArgv -> do
            jArgv' <- packUTF8CArray jArgv
            return jArgv'
    result <- g_application_run _obj' argc maybeArgv
    touchManagedPtr _obj
    (mapCArrayWithLength argc) freeMem maybeArgv
    freeMem maybeArgv
    return result

-- method Application::send_notification
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notification", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "notification", argType = TInterface "Gio" "Notification", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_send_notification" g_application_send_notification :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    CString ->                              -- id : TBasicType TUTF8
    Ptr Notification ->                     -- notification : TInterface "Gio" "Notification"
    IO ()


applicationSendNotification ::
    (MonadIO m, ApplicationK a, NotificationK b) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- id
    b ->                                    -- notification
    m ()
applicationSendNotification _obj id notification = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeId <- case id of
        Nothing -> return nullPtr
        Just jId -> do
            jId' <- textToCString jId
            return jId'
    let notification' = unsafeManagedPtrCastPtr notification
    g_application_send_notification _obj' maybeId notification'
    touchManagedPtr _obj
    touchManagedPtr notification
    freeMem maybeId
    return ()

-- method Application::set_action_group
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_group", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "action_group", argType = TInterface "Gio" "ActionGroup", direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_set_action_group" g_application_set_action_group :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Ptr ActionGroup ->                      -- action_group : TInterface "Gio" "ActionGroup"
    IO ()

{-# DEPRECATED applicationSetActionGroup ["(Since version 2.32)","Use the #GActionMap interface instead.  Never ever","mix use of this API with use of #GActionMap on the same @application","or things will go very badly wrong.  This function is known to","introduce buggy behaviour (ie: signals not emitted on changes to the","action group), so you should really use #GActionMap instead."]#-}
applicationSetActionGroup ::
    (MonadIO m, ApplicationK a, ActionGroupK b) =>
    a ->                                    -- _obj
    Maybe (b) ->                            -- action_group
    m ()
applicationSetActionGroup _obj action_group = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeAction_group <- case action_group of
        Nothing -> return nullPtr
        Just jAction_group -> do
            let jAction_group' = unsafeManagedPtrCastPtr jAction_group
            return jAction_group'
    g_application_set_action_group _obj' maybeAction_group
    touchManagedPtr _obj
    whenJust action_group touchManagedPtr
    return ()

-- method Application::set_application_id
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_set_application_id" g_application_set_application_id :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    CString ->                              -- application_id : TBasicType TUTF8
    IO ()


applicationSetApplicationId ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- application_id
    m ()
applicationSetApplicationId _obj application_id = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeApplication_id <- case application_id of
        Nothing -> return nullPtr
        Just jApplication_id -> do
            jApplication_id' <- textToCString jApplication_id
            return jApplication_id'
    g_application_set_application_id _obj' maybeApplication_id
    touchManagedPtr _obj
    freeMem maybeApplication_id
    return ()

-- method Application::set_default
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_set_default" g_application_set_default :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO ()


applicationSetDefault ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m ()
applicationSetDefault _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_application_set_default _obj'
    touchManagedPtr _obj
    return ()

-- method Application::set_flags
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ApplicationFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "flags", argType = TInterface "Gio" "ApplicationFlags", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_set_flags" g_application_set_flags :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    CUInt ->                                -- flags : TInterface "Gio" "ApplicationFlags"
    IO ()


applicationSetFlags ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    [ApplicationFlags] ->                   -- flags
    m ()
applicationSetFlags _obj flags = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let flags' = gflagsToWord flags
    g_application_set_flags _obj' flags'
    touchManagedPtr _obj
    return ()

-- method Application::set_inactivity_timeout
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inactivity_timeout", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "inactivity_timeout", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_set_inactivity_timeout" g_application_set_inactivity_timeout :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Word32 ->                               -- inactivity_timeout : TBasicType TUInt32
    IO ()


applicationSetInactivityTimeout ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    Word32 ->                               -- inactivity_timeout
    m ()
applicationSetInactivityTimeout _obj inactivity_timeout = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_application_set_inactivity_timeout _obj' inactivity_timeout
    touchManagedPtr _obj
    return ()

-- method Application::set_resource_base_path
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "resource_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "resource_path", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = True, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_set_resource_base_path" g_application_set_resource_base_path :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    CString ->                              -- resource_path : TBasicType TUTF8
    IO ()


applicationSetResourceBasePath ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    Maybe (T.Text) ->                       -- resource_path
    m ()
applicationSetResourceBasePath _obj resource_path = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    maybeResource_path <- case resource_path of
        Nothing -> return nullPtr
        Just jResource_path -> do
            jResource_path' <- textToCString jResource_path
            return jResource_path'
    g_application_set_resource_base_path _obj' maybeResource_path
    touchManagedPtr _obj
    freeMem maybeResource_path
    return ()

-- method Application::unbind_busy_property
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "object", argType = TInterface "GObject" "Object", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "property", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_unbind_busy_property" g_application_unbind_busy_property :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    Ptr GObject.Object ->                   -- object : TInterface "GObject" "Object"
    CString ->                              -- property : TBasicType TUTF8
    IO ()


applicationUnbindBusyProperty ::
    (MonadIO m, ApplicationK a, GObject.ObjectK b) =>
    a ->                                    -- _obj
    b ->                                    -- object
    T.Text ->                               -- property
    m ()
applicationUnbindBusyProperty _obj object property = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    let object' = unsafeManagedPtrCastPtr object
    property' <- textToCString property
    g_application_unbind_busy_property _obj' object' property'
    touchManagedPtr _obj
    touchManagedPtr object
    freeMem property'
    return ()

-- method Application::unmark_busy
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_unmark_busy" g_application_unmark_busy :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    IO ()


applicationUnmarkBusy ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    m ()
applicationUnmarkBusy _obj = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    g_application_unmark_busy _obj'
    touchManagedPtr _obj
    return ()

-- method Application::withdraw_notification
-- method type : OrdinaryMethod
-- Args : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "_obj", argType = TInterface "Gio" "Application", direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing},Arg {argName = "id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TVoid
-- throws : False
-- Skip return : False

foreign import ccall "g_application_withdraw_notification" g_application_withdraw_notification :: 
    Ptr Application ->                      -- _obj : TInterface "Gio" "Application"
    CString ->                              -- id : TBasicType TUTF8
    IO ()


applicationWithdrawNotification ::
    (MonadIO m, ApplicationK a) =>
    a ->                                    -- _obj
    T.Text ->                               -- id
    m ()
applicationWithdrawNotification _obj id = liftIO $ do
    let _obj' = unsafeManagedPtrCastPtr _obj
    id' <- textToCString id
    g_application_withdraw_notification _obj' id'
    touchManagedPtr _obj
    freeMem id'
    return ()

-- method Application::get_default
-- method type : MemberFunction
-- Args : []
-- Lengths : []
-- hInArgs : []
-- returnType : TInterface "Gio" "Application"
-- throws : False
-- Skip return : False

foreign import ccall "g_application_get_default" g_application_get_default :: 
    IO (Ptr Application)


applicationGetDefault ::
    (MonadIO m) =>
    m Application
applicationGetDefault  = liftIO $ do
    result <- g_application_get_default
    checkUnexpectedReturnNULL "g_application_get_default" result
    result' <- (newObject Application) result
    return result'

-- method Application::id_is_valid
-- method type : MemberFunction
-- Args : [Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- Lengths : []
-- hInArgs : [Arg {argName = "application_id", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, transfer = TransferNothing}]
-- returnType : TBasicType TBoolean
-- throws : False
-- Skip return : False

foreign import ccall "g_application_id_is_valid" g_application_id_is_valid :: 
    CString ->                              -- application_id : TBasicType TUTF8
    IO CInt


applicationIdIsValid ::
    (MonadIO m) =>
    T.Text ->                               -- application_id
    m Bool
applicationIdIsValid application_id = liftIO $ do
    application_id' <- textToCString application_id
    result <- g_application_id_is_valid application_id'
    let result' = (/= 0) result
    freeMem application_id'
    return result'