{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Interfaces.AppInfo.AppInfo' and t'GI.Gio.Objects.AppLaunchContext.AppLaunchContext' are used for describing and launching
-- applications installed on the system.
-- 
-- As of GLib 2.20, URIs will always be converted to POSIX paths
-- (using 'GI.Gio.Interfaces.File.fileGetPath') when using 'GI.Gio.Interfaces.AppInfo.appInfoLaunch' even if
-- the application requested an URI and not a POSIX path. For example
-- for an desktop-file based application with Exec key @totem
-- %U@ and a single URI, @sftp:\/\/foo\/file.avi@, then
-- @\/home\/user\/.gvfs\/sftp on foo\/file.avi@ will be passed. This will
-- only work if a set of suitable GIO extensions (such as gvfs 2.26
-- compiled with FUSE support), is available and operational; if this
-- is not the case, the URI will be passed unmodified to the application.
-- Some URIs, such as @mailto:@, of course cannot be mapped to a POSIX
-- path (in gvfs there\'s no FUSE mount for it); such URIs will be
-- passed unmodified to the application.
-- 
-- Specifically for gvfs 2.26 and later, the POSIX URI will be mapped
-- back to the GIO URI in the t'GI.Gio.Interfaces.File.File' constructors (since gvfs
-- implements the t'GI.Gio.Objects.Vfs.Vfs' extension point). As such, if the application
-- needs to examine the URI, it needs to use 'GI.Gio.Interfaces.File.fileGetUri' or
-- similar on t'GI.Gio.Interfaces.File.File'. In other words, an application cannot assume
-- that the URI passed to e.g. 'GI.Gio.Functions.fileNewForCommandlineArg' is
-- equal to the result of 'GI.Gio.Interfaces.File.fileGetUri'. The following snippet
-- illustrates this:
-- 
-- >
-- >GFile *f;
-- >char *uri;
-- >
-- >file = g_file_new_for_commandline_arg (uri_from_commandline);
-- >
-- >uri = g_file_get_uri (file);
-- >strcmp (uri, uri_from_commandline) == 0;
-- >g_free (uri);
-- >
-- >if (g_file_has_uri_scheme (file, "cdda"))
-- >  {
-- >    // do something special with uri
-- >  }
-- >g_object_unref (file);
-- 
-- 
-- This code will work when both @cdda:\/\/sr0\/Track 1.wav@ and
-- @\/home\/user\/.gvfs\/cdda on sr0\/Track 1.wav@ is passed to the
-- application. It should be noted that it\'s generally not safe
-- for applications to rely on the format of a particular URIs.
-- Different launcher applications (e.g. file managers) may have
-- different ideas of what a given URI means.

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

module GI.Gio.Interfaces.AppInfo
    ( 

-- * Exported types
    AppInfo(..)                             ,
    noAppInfo                               ,
    IsAppInfo                               ,
    toAppInfo                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAppInfoMethod                    ,
#endif


-- ** addSupportsType #method:addSupportsType#

#if defined(ENABLE_OVERLOADING)
    AppInfoAddSupportsTypeMethodInfo        ,
#endif
    appInfoAddSupportsType                  ,


-- ** canDelete #method:canDelete#

#if defined(ENABLE_OVERLOADING)
    AppInfoCanDeleteMethodInfo              ,
#endif
    appInfoCanDelete                        ,


-- ** canRemoveSupportsType #method:canRemoveSupportsType#

#if defined(ENABLE_OVERLOADING)
    AppInfoCanRemoveSupportsTypeMethodInfo  ,
#endif
    appInfoCanRemoveSupportsType            ,


-- ** createFromCommandline #method:createFromCommandline#

    appInfoCreateFromCommandline            ,


-- ** delete #method:delete#

#if defined(ENABLE_OVERLOADING)
    AppInfoDeleteMethodInfo                 ,
#endif
    appInfoDelete                           ,


-- ** dup #method:dup#

#if defined(ENABLE_OVERLOADING)
    AppInfoDupMethodInfo                    ,
#endif
    appInfoDup                              ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    AppInfoEqualMethodInfo                  ,
#endif
    appInfoEqual                            ,


-- ** getAll #method:getAll#

    appInfoGetAll                           ,


-- ** getAllForType #method:getAllForType#

    appInfoGetAllForType                    ,


-- ** getCommandline #method:getCommandline#

#if defined(ENABLE_OVERLOADING)
    AppInfoGetCommandlineMethodInfo         ,
#endif
    appInfoGetCommandline                   ,


-- ** getDefaultForType #method:getDefaultForType#

    appInfoGetDefaultForType                ,


-- ** getDefaultForUriScheme #method:getDefaultForUriScheme#

    appInfoGetDefaultForUriScheme           ,


-- ** getDescription #method:getDescription#

#if defined(ENABLE_OVERLOADING)
    AppInfoGetDescriptionMethodInfo         ,
#endif
    appInfoGetDescription                   ,


-- ** getDisplayName #method:getDisplayName#

#if defined(ENABLE_OVERLOADING)
    AppInfoGetDisplayNameMethodInfo         ,
#endif
    appInfoGetDisplayName                   ,


-- ** getExecutable #method:getExecutable#

#if defined(ENABLE_OVERLOADING)
    AppInfoGetExecutableMethodInfo          ,
#endif
    appInfoGetExecutable                    ,


-- ** getFallbackForType #method:getFallbackForType#

    appInfoGetFallbackForType               ,


-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    AppInfoGetIconMethodInfo                ,
#endif
    appInfoGetIcon                          ,


-- ** getId #method:getId#

#if defined(ENABLE_OVERLOADING)
    AppInfoGetIdMethodInfo                  ,
#endif
    appInfoGetId                            ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    AppInfoGetNameMethodInfo                ,
#endif
    appInfoGetName                          ,


-- ** getRecommendedForType #method:getRecommendedForType#

    appInfoGetRecommendedForType            ,


-- ** getSupportedTypes #method:getSupportedTypes#

#if defined(ENABLE_OVERLOADING)
    AppInfoGetSupportedTypesMethodInfo      ,
#endif
    appInfoGetSupportedTypes                ,


-- ** launch #method:launch#

#if defined(ENABLE_OVERLOADING)
    AppInfoLaunchMethodInfo                 ,
#endif
    appInfoLaunch                           ,


-- ** launchDefaultForUri #method:launchDefaultForUri#

    appInfoLaunchDefaultForUri              ,


-- ** launchDefaultForUriAsync #method:launchDefaultForUriAsync#

    appInfoLaunchDefaultForUriAsync         ,


-- ** launchDefaultForUriFinish #method:launchDefaultForUriFinish#

    appInfoLaunchDefaultForUriFinish        ,


-- ** launchUris #method:launchUris#

#if defined(ENABLE_OVERLOADING)
    AppInfoLaunchUrisMethodInfo             ,
#endif
    appInfoLaunchUris                       ,


-- ** launchUrisAsync #method:launchUrisAsync#

#if defined(ENABLE_OVERLOADING)
    AppInfoLaunchUrisAsyncMethodInfo        ,
#endif
    appInfoLaunchUrisAsync                  ,


-- ** launchUrisFinish #method:launchUrisFinish#

#if defined(ENABLE_OVERLOADING)
    AppInfoLaunchUrisFinishMethodInfo       ,
#endif
    appInfoLaunchUrisFinish                 ,


-- ** removeSupportsType #method:removeSupportsType#

#if defined(ENABLE_OVERLOADING)
    AppInfoRemoveSupportsTypeMethodInfo     ,
#endif
    appInfoRemoveSupportsType               ,


-- ** resetTypeAssociations #method:resetTypeAssociations#

    appInfoResetTypeAssociations            ,


-- ** setAsDefaultForExtension #method:setAsDefaultForExtension#

#if defined(ENABLE_OVERLOADING)
    AppInfoSetAsDefaultForExtensionMethodInfo,
#endif
    appInfoSetAsDefaultForExtension         ,


-- ** setAsDefaultForType #method:setAsDefaultForType#

#if defined(ENABLE_OVERLOADING)
    AppInfoSetAsDefaultForTypeMethodInfo    ,
#endif
    appInfoSetAsDefaultForType              ,


-- ** setAsLastUsedForType #method:setAsLastUsedForType#

#if defined(ENABLE_OVERLOADING)
    AppInfoSetAsLastUsedForTypeMethodInfo   ,
#endif
    appInfoSetAsLastUsedForType             ,


-- ** shouldShow #method:shouldShow#

#if defined(ENABLE_OVERLOADING)
    AppInfoShouldShowMethodInfo             ,
#endif
    appInfoShouldShow                       ,


-- ** supportsFiles #method:supportsFiles#

#if defined(ENABLE_OVERLOADING)
    AppInfoSupportsFilesMethodInfo          ,
#endif
    appInfoSupportsFiles                    ,


-- ** supportsUris #method:supportsUris#

#if defined(ENABLE_OVERLOADING)
    AppInfoSupportsUrisMethodInfo           ,
#endif
    appInfoSupportsUris                     ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Flags as Gio.Flags
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Interfaces.File as Gio.File
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Icon as Gio.Icon
import {-# SOURCE #-} qualified GI.Gio.Objects.AppLaunchContext as Gio.AppLaunchContext
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

-- interface AppInfo 
-- | Memory-managed wrapper type.
newtype AppInfo = AppInfo (ManagedPtr AppInfo)
    deriving (AppInfo -> AppInfo -> Bool
(AppInfo -> AppInfo -> Bool)
-> (AppInfo -> AppInfo -> Bool) -> Eq AppInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AppInfo -> AppInfo -> Bool
$c/= :: AppInfo -> AppInfo -> Bool
== :: AppInfo -> AppInfo -> Bool
$c== :: AppInfo -> AppInfo -> Bool
Eq)
-- | A convenience alias for `Nothing` :: `Maybe` `AppInfo`.
noAppInfo :: Maybe AppInfo
noAppInfo :: Maybe AppInfo
noAppInfo = Maybe AppInfo
forall a. Maybe a
Nothing

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

#endif

foreign import ccall "g_app_info_get_type"
    c_g_app_info_get_type :: IO GType

instance GObject AppInfo where
    gobjectType :: IO GType
gobjectType = IO GType
c_g_app_info_get_type
    

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

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

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

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

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AppInfo
type instance O.AttributeList AppInfo = AppInfoAttributeList
type AppInfoAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveAppInfoMethod (t :: Symbol) (o :: *) :: * where
    ResolveAppInfoMethod "addSupportsType" o = AppInfoAddSupportsTypeMethodInfo
    ResolveAppInfoMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAppInfoMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAppInfoMethod "canDelete" o = AppInfoCanDeleteMethodInfo
    ResolveAppInfoMethod "canRemoveSupportsType" o = AppInfoCanRemoveSupportsTypeMethodInfo
    ResolveAppInfoMethod "delete" o = AppInfoDeleteMethodInfo
    ResolveAppInfoMethod "dup" o = AppInfoDupMethodInfo
    ResolveAppInfoMethod "equal" o = AppInfoEqualMethodInfo
    ResolveAppInfoMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAppInfoMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAppInfoMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAppInfoMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAppInfoMethod "launch" o = AppInfoLaunchMethodInfo
    ResolveAppInfoMethod "launchUris" o = AppInfoLaunchUrisMethodInfo
    ResolveAppInfoMethod "launchUrisAsync" o = AppInfoLaunchUrisAsyncMethodInfo
    ResolveAppInfoMethod "launchUrisFinish" o = AppInfoLaunchUrisFinishMethodInfo
    ResolveAppInfoMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAppInfoMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAppInfoMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAppInfoMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAppInfoMethod "removeSupportsType" o = AppInfoRemoveSupportsTypeMethodInfo
    ResolveAppInfoMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAppInfoMethod "shouldShow" o = AppInfoShouldShowMethodInfo
    ResolveAppInfoMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAppInfoMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAppInfoMethod "supportsFiles" o = AppInfoSupportsFilesMethodInfo
    ResolveAppInfoMethod "supportsUris" o = AppInfoSupportsUrisMethodInfo
    ResolveAppInfoMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAppInfoMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAppInfoMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAppInfoMethod "getCommandline" o = AppInfoGetCommandlineMethodInfo
    ResolveAppInfoMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAppInfoMethod "getDescription" o = AppInfoGetDescriptionMethodInfo
    ResolveAppInfoMethod "getDisplayName" o = AppInfoGetDisplayNameMethodInfo
    ResolveAppInfoMethod "getExecutable" o = AppInfoGetExecutableMethodInfo
    ResolveAppInfoMethod "getIcon" o = AppInfoGetIconMethodInfo
    ResolveAppInfoMethod "getId" o = AppInfoGetIdMethodInfo
    ResolveAppInfoMethod "getName" o = AppInfoGetNameMethodInfo
    ResolveAppInfoMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAppInfoMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAppInfoMethod "getSupportedTypes" o = AppInfoGetSupportedTypesMethodInfo
    ResolveAppInfoMethod "setAsDefaultForExtension" o = AppInfoSetAsDefaultForExtensionMethodInfo
    ResolveAppInfoMethod "setAsDefaultForType" o = AppInfoSetAsDefaultForTypeMethodInfo
    ResolveAppInfoMethod "setAsLastUsedForType" o = AppInfoSetAsLastUsedForTypeMethodInfo
    ResolveAppInfoMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAppInfoMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAppInfoMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAppInfoMethod l o = O.MethodResolutionFailed l o

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

#endif

-- method AppInfo::add_supports_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_add_supports_type" g_app_info_add_supports_type :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    CString ->                              -- content_type : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Adds a content type to the application information to indicate the
-- application is capable of opening files with the given content type.
appInfoAddSupportsType ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> T.Text
    -- ^ /@contentType@/: a string.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoAddSupportsType :: a -> Text -> m ()
appInfoAddSupportsType appinfo :: a
appinfo contentType :: Text
contentType = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AppInfo -> CString -> Ptr (Ptr GError) -> IO CInt
g_app_info_add_supports_type Ptr AppInfo
appinfo' CString
contentType'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
     )

#if defined(ENABLE_OVERLOADING)
data AppInfoAddSupportsTypeMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoAddSupportsTypeMethodInfo a signature where
    overloadedMethod = appInfoAddSupportsType

#endif

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

foreign import ccall "g_app_info_can_delete" g_app_info_can_delete :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CInt

-- | Obtains the information whether the t'GI.Gio.Interfaces.AppInfo.AppInfo' can be deleted.
-- See 'GI.Gio.Interfaces.AppInfo.appInfoDelete'.
-- 
-- /Since: 2.20/
appInfoCanDelete ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@appinfo@/ can be deleted
appInfoCanDelete :: a -> m Bool
appInfoCanDelete appinfo :: a
appinfo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CInt
result <- Ptr AppInfo -> IO CInt
g_app_info_can_delete Ptr AppInfo
appinfo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoCanDeleteMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoCanDeleteMethodInfo a signature where
    overloadedMethod = appInfoCanDelete

#endif

-- method AppInfo::can_remove_supports_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_can_remove_supports_type" g_app_info_can_remove_supports_type :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CInt

-- | Checks if a supported content type can be removed from an application.
appInfoCanRemoveSupportsType ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if it is possible to remove supported
    --     content types from a given /@appinfo@/, 'P.False' if not.
appInfoCanRemoveSupportsType :: a -> m Bool
appInfoCanRemoveSupportsType appinfo :: a
appinfo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CInt
result <- Ptr AppInfo -> IO CInt
g_app_info_can_remove_supports_type Ptr AppInfo
appinfo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoCanRemoveSupportsTypeMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoCanRemoveSupportsTypeMethodInfo a signature where
    overloadedMethod = appInfoCanRemoveSupportsType

#endif

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

foreign import ccall "g_app_info_delete" g_app_info_delete :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CInt

-- | Tries to delete a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
-- 
-- On some platforms, there may be a difference between user-defined
-- @/GAppInfos/@ which can be deleted, and system-wide ones which cannot.
-- See 'GI.Gio.Interfaces.AppInfo.appInfoCanDelete'.
-- 
-- /Since: 2.20/
appInfoDelete ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@appinfo@/ has been deleted
appInfoDelete :: a -> m Bool
appInfoDelete appinfo :: a
appinfo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CInt
result <- Ptr AppInfo -> IO CInt
g_app_info_delete Ptr AppInfo
appinfo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoDeleteMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoDeleteMethodInfo a signature where
    overloadedMethod = appInfoDelete

#endif

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

foreign import ccall "g_app_info_dup" g_app_info_dup :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO (Ptr AppInfo)

-- | Creates a duplicate of a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
appInfoDup ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m AppInfo
    -- ^ __Returns:__ a duplicate of /@appinfo@/.
appInfoDup :: a -> m AppInfo
appInfoDup appinfo :: a
appinfo = IO AppInfo -> m AppInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppInfo -> m AppInfo) -> IO AppInfo -> m AppInfo
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    Ptr AppInfo
result <- Ptr AppInfo -> IO (Ptr AppInfo)
g_app_info_dup Ptr AppInfo
appinfo'
    Text -> Ptr AppInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoDup" Ptr AppInfo
result
    AppInfo
result' <- ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
AppInfo) Ptr AppInfo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    AppInfo -> IO AppInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AppInfo
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoDupMethodInfo
instance (signature ~ (m AppInfo), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoDupMethodInfo a signature where
    overloadedMethod = appInfoDup

#endif

-- method AppInfo::equal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo1"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the first #GAppInfo."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "appinfo2"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the second #GAppInfo."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_equal" g_app_info_equal :: 
    Ptr AppInfo ->                          -- appinfo1 : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    Ptr AppInfo ->                          -- appinfo2 : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CInt

-- | Checks if two @/GAppInfos/@ are equal.
-- 
-- Note that the check \<emphasis>may not\<\/emphasis> compare each individual
-- field, and only does an identity check. In case detecting changes in the
-- contents is needed, program code must additionally compare relevant fields.
appInfoEqual ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a, IsAppInfo b) =>
    a
    -- ^ /@appinfo1@/: the first t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> b
    -- ^ /@appinfo2@/: the second t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@appinfo1@/ is equal to /@appinfo2@/. 'P.False' otherwise.
appInfoEqual :: a -> b -> m Bool
appInfoEqual appinfo1 :: a
appinfo1 appinfo2 :: b
appinfo2 = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo1' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo1
    Ptr AppInfo
appinfo2' <- b -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
appinfo2
    CInt
result <- Ptr AppInfo -> Ptr AppInfo -> IO CInt
g_app_info_equal Ptr AppInfo
appinfo1' Ptr AppInfo
appinfo2'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo1
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
appinfo2
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoEqualMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsAppInfo a, IsAppInfo b) => O.MethodInfo AppInfoEqualMethodInfo a signature where
    overloadedMethod = appInfoEqual

#endif

-- method AppInfo::get_commandline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_commandline" g_app_info_get_commandline :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CString

-- | Gets the commandline with which the application will be
-- started.
-- 
-- /Since: 2.20/
appInfoGetCommandline ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> m [Char]
    -- ^ __Returns:__ a string containing the /@appinfo@/\'s commandline,
    --     or 'P.Nothing' if this information is not available
appInfoGetCommandline :: a -> m [Char]
appInfoGetCommandline appinfo :: a
appinfo = IO [Char] -> m [Char]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
result <- Ptr AppInfo -> IO CString
g_app_info_get_commandline Ptr AppInfo
appinfo'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetCommandline" CString
result
    [Char]
result' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoGetCommandlineMethodInfo
instance (signature ~ (m [Char]), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoGetCommandlineMethodInfo a signature where
    overloadedMethod = appInfoGetCommandline

#endif

-- method AppInfo::get_description
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_description" g_app_info_get_description :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CString

-- | Gets a human-readable description of an installed application.
appInfoGetDescription ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m T.Text
    -- ^ __Returns:__ a string containing a description of the
    -- application /@appinfo@/, or 'P.Nothing' if none.
appInfoGetDescription :: a -> m Text
appInfoGetDescription appinfo :: a
appinfo = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
result <- Ptr AppInfo -> IO CString
g_app_info_get_description Ptr AppInfo
appinfo'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetDescription" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoGetDescriptionMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoGetDescriptionMethodInfo a signature where
    overloadedMethod = appInfoGetDescription

#endif

-- method AppInfo::get_display_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_display_name" g_app_info_get_display_name :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CString

-- | Gets the display name of the application. The display name is often more
-- descriptive to the user than the name itself.
-- 
-- /Since: 2.24/
appInfoGetDisplayName ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m T.Text
    -- ^ __Returns:__ the display name of the application for /@appinfo@/, or the name if
    -- no display name is available.
appInfoGetDisplayName :: a -> m Text
appInfoGetDisplayName appinfo :: a
appinfo = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
result <- Ptr AppInfo -> IO CString
g_app_info_get_display_name Ptr AppInfo
appinfo'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetDisplayName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoGetDisplayNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoGetDisplayNameMethodInfo a signature where
    overloadedMethod = appInfoGetDisplayName

#endif

-- method AppInfo::get_executable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TFileName)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_executable" g_app_info_get_executable :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CString

-- | Gets the executable\'s name for the installed application.
appInfoGetExecutable ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> m [Char]
    -- ^ __Returns:__ a string containing the /@appinfo@/\'s application
    -- binaries name
appInfoGetExecutable :: a -> m [Char]
appInfoGetExecutable appinfo :: a
appinfo = IO [Char] -> m [Char]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
result <- Ptr AppInfo -> IO CString
g_app_info_get_executable Ptr AppInfo
appinfo'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetExecutable" CString
result
    [Char]
result' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    [Char] -> IO [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoGetExecutableMethodInfo
instance (signature ~ (m [Char]), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoGetExecutableMethodInfo a signature where
    overloadedMethod = appInfoGetExecutable

#endif

-- method AppInfo::get_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Icon" })
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_icon" g_app_info_get_icon :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the icon for the application.
appInfoGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ the default t'GI.Gio.Interfaces.Icon.Icon' for /@appinfo@/ or 'P.Nothing'
    -- if there is no default icon.
appInfoGetIcon :: a -> m Icon
appInfoGetIcon appinfo :: a
appinfo = IO Icon -> m Icon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Icon -> m Icon) -> IO Icon -> m Icon
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    Ptr Icon
result <- Ptr AppInfo -> IO (Ptr Icon)
g_app_info_get_icon Ptr AppInfo
appinfo'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetIcon" Ptr Icon
result
    Icon
result' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoGetIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoGetIconMethodInfo a signature where
    overloadedMethod = appInfoGetIcon

#endif

-- method AppInfo::get_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_id" g_app_info_get_id :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CString

-- | Gets the ID of an application. An id is a string that
-- identifies the application. The exact format of the id is
-- platform dependent. For instance, on Unix this is the
-- desktop file id from the xdg menu specification.
-- 
-- Note that the returned ID may be 'P.Nothing', depending on how
-- the /@appinfo@/ has been constructed.
appInfoGetId ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m T.Text
    -- ^ __Returns:__ a string containing the application\'s ID.
appInfoGetId :: a -> m Text
appInfoGetId appinfo :: a
appinfo = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
result <- Ptr AppInfo -> IO CString
g_app_info_get_id Ptr AppInfo
appinfo'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetId" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoGetIdMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoGetIdMethodInfo a signature where
    overloadedMethod = appInfoGetId

#endif

-- method AppInfo::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_name" g_app_info_get_name :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CString

-- | Gets the installed name of the application.
appInfoGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m T.Text
    -- ^ __Returns:__ the name of the application for /@appinfo@/.
appInfoGetName :: a -> m Text
appInfoGetName appinfo :: a
appinfo = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
result <- Ptr AppInfo -> IO CString
g_app_info_get_name Ptr AppInfo
appinfo'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoGetNameMethodInfo a signature where
    overloadedMethod = appInfoGetName

#endif

-- method AppInfo::get_supported_types
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo that can handle files"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_supported_types" g_app_info_get_supported_types :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO (Ptr CString)

-- | Retrieves the list of content types that /@appInfo@/ claims to support.
-- If this information is not provided by the environment, this function
-- will return 'P.Nothing'.
-- This function does not take in consideration associations added with
-- 'GI.Gio.Interfaces.AppInfo.appInfoAddSupportsType', but only those exported directly by
-- the application.
-- 
-- /Since: 2.34/
appInfoGetSupportedTypes ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo' that can handle files
    -> m [T.Text]
    -- ^ __Returns:__ 
    --    a list of content types.
appInfoGetSupportedTypes :: a -> m [Text]
appInfoGetSupportedTypes appinfo :: a
appinfo = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    Ptr CString
result <- Ptr AppInfo -> IO (Ptr CString)
g_app_info_get_supported_types Ptr AppInfo
appinfo'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetSupportedTypes" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoGetSupportedTypesMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoGetSupportedTypesMethodInfo a signature where
    overloadedMethod = appInfoGetSupportedTypes

#endif

-- method AppInfo::launch
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "files"
--           , argType =
--               TGList (TInterface Name { namespace = "Gio" , name = "File" })
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList of #GFile objects"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppLaunchContext" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppLaunchContext or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_launch" g_app_info_launch :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    Ptr (GList (Ptr Gio.File.File)) ->      -- files : TGList (TInterface (Name {namespace = "Gio", name = "File"}))
    Ptr Gio.AppLaunchContext.AppLaunchContext -> -- context : TInterface (Name {namespace = "Gio", name = "AppLaunchContext"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Launches the application. Passes /@files@/ to the launched application
-- as arguments, using the optional /@context@/ to get information
-- about the details of the launcher (like what screen it is on).
-- On error, /@error@/ will be set accordingly.
-- 
-- To launch the application without arguments pass a 'P.Nothing' /@files@/ list.
-- 
-- Note that even if the launch is successful the application launched
-- can fail to start if it runs into problems during startup. There is
-- no way to detect this.
-- 
-- Some URIs can be changed when passed through a GFile (for instance
-- unsupported URIs with strange formats like mailto:), so if you have
-- a textual URI you want to pass in as argument, consider using
-- 'GI.Gio.Interfaces.AppInfo.appInfoLaunchUris' instead.
-- 
-- The launched application inherits the environment of the launching
-- process, but it can be modified with 'GI.Gio.Objects.AppLaunchContext.appLaunchContextSetenv'
-- and 'GI.Gio.Objects.AppLaunchContext.appLaunchContextUnsetenv'.
-- 
-- On UNIX, this function sets the @GIO_LAUNCHED_DESKTOP_FILE@
-- environment variable with the path of the launched desktop file and
-- @GIO_LAUNCHED_DESKTOP_FILE_PID@ to the process id of the launched
-- process. This can be used to ignore @GIO_LAUNCHED_DESKTOP_FILE@,
-- should it be inherited by further processes. The @DISPLAY@ and
-- @DESKTOP_STARTUP_ID@ environment variables are also set, based
-- on information provided in /@context@/.
appInfoLaunch ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a, Gio.File.IsFile b, Gio.AppLaunchContext.IsAppLaunchContext c) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> [b]
    -- ^ /@files@/: a t'GI.GLib.Structs.List.List' of t'GI.Gio.Interfaces.File.File' objects
    -> Maybe (c)
    -- ^ /@context@/: a t'GI.Gio.Objects.AppLaunchContext.AppLaunchContext' or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoLaunch :: a -> [b] -> Maybe c -> m ()
appInfoLaunch appinfo :: a
appinfo files :: [b]
files context :: Maybe c
context = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    [Ptr File]
files' <- (b -> IO (Ptr File)) -> [b] -> IO [Ptr File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [b]
files
    Ptr (GList (Ptr File))
files'' <- [Ptr File] -> IO (Ptr (GList (Ptr File)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr File]
files'
    Ptr AppLaunchContext
maybeContext <- case Maybe c
context of
        Nothing -> Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
forall a. Ptr a
nullPtr
        Just jContext :: c
jContext -> do
            Ptr AppLaunchContext
jContext' <- c -> IO (Ptr AppLaunchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jContext
            Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
jContext'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AppInfo
-> Ptr (GList (Ptr File))
-> Ptr AppLaunchContext
-> Ptr (Ptr GError)
-> IO CInt
g_app_info_launch Ptr AppInfo
appinfo' Ptr (GList (Ptr File))
files'' Ptr AppLaunchContext
maybeContext
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
        (b -> IO ()) -> [b] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [b]
files
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
context c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (GList (Ptr File)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr File))
files''
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr (GList (Ptr File)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr File))
files''
     )

#if defined(ENABLE_OVERLOADING)
data AppInfoLaunchMethodInfo
instance (signature ~ ([b] -> Maybe (c) -> m ()), MonadIO m, IsAppInfo a, Gio.File.IsFile b, Gio.AppLaunchContext.IsAppLaunchContext c) => O.MethodInfo AppInfoLaunchMethodInfo a signature where
    overloadedMethod = appInfoLaunch

#endif

-- method AppInfo::launch_uris
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uris"
--           , argType = TGList (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList containing URIs to launch."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppLaunchContext" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppLaunchContext or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_launch_uris" g_app_info_launch_uris :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    Ptr (GList CString) ->                  -- uris : TGList (TBasicType TUTF8)
    Ptr Gio.AppLaunchContext.AppLaunchContext -> -- context : TInterface (Name {namespace = "Gio", name = "AppLaunchContext"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Launches the application. This passes the /@uris@/ to the launched application
-- as arguments, using the optional /@context@/ to get information
-- about the details of the launcher (like what screen it is on).
-- On error, /@error@/ will be set accordingly.
-- 
-- To launch the application without arguments pass a 'P.Nothing' /@uris@/ list.
-- 
-- Note that even if the launch is successful the application launched
-- can fail to start if it runs into problems during startup. There is
-- no way to detect this.
appInfoLaunchUris ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a, Gio.AppLaunchContext.IsAppLaunchContext b) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> [T.Text]
    -- ^ /@uris@/: a t'GI.GLib.Structs.List.List' containing URIs to launch.
    -> Maybe (b)
    -- ^ /@context@/: a t'GI.Gio.Objects.AppLaunchContext.AppLaunchContext' or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoLaunchUris :: a -> [Text] -> Maybe b -> m ()
appInfoLaunchUris appinfo :: a
appinfo uris :: [Text]
uris context :: Maybe b
context = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    [CString]
uris' <- (Text -> IO CString) -> [Text] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO CString
textToCString [Text]
uris
    Ptr (GList CString)
uris'' <- [CString] -> IO (Ptr (GList CString))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [CString]
uris'
    Ptr AppLaunchContext
maybeContext <- case Maybe b
context of
        Nothing -> Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
forall a. Ptr a
nullPtr
        Just jContext :: b
jContext -> do
            Ptr AppLaunchContext
jContext' <- b -> IO (Ptr AppLaunchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jContext
            Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
jContext'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AppInfo
-> Ptr (GList CString)
-> Ptr AppLaunchContext
-> Ptr (Ptr GError)
-> IO CInt
g_app_info_launch_uris Ptr AppInfo
appinfo' Ptr (GList CString)
uris'' Ptr AppLaunchContext
maybeContext
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
context b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
uris''
        Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
uris''
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
uris''
        Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
uris''
     )

#if defined(ENABLE_OVERLOADING)
data AppInfoLaunchUrisMethodInfo
instance (signature ~ ([T.Text] -> Maybe (b) -> m ()), MonadIO m, IsAppInfo a, Gio.AppLaunchContext.IsAppLaunchContext b) => O.MethodInfo AppInfoLaunchUrisMethodInfo a signature where
    overloadedMethod = appInfoLaunchUris

#endif

-- method AppInfo::launch_uris_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uris"
--           , argType = TGList (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList containing URIs to launch."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppLaunchContext" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppLaunchContext or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when the request is done"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_launch_uris_async" g_app_info_launch_uris_async :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    Ptr (GList CString) ->                  -- uris : TGList (TBasicType TUTF8)
    Ptr Gio.AppLaunchContext.AppLaunchContext -> -- context : TInterface (Name {namespace = "Gio", name = "AppLaunchContext"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Async version of 'GI.Gio.Interfaces.AppInfo.appInfoLaunchUris'.
-- 
-- The /@callback@/ is invoked immediately after the application launch, but it
-- waits for activation in case of D-Bus–activated applications and also provides
-- extended error information for sandboxed applications, see notes for
-- 'GI.Gio.Functions.appInfoLaunchDefaultForUriAsync'.
-- 
-- /Since: 2.60/
appInfoLaunchUrisAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a, Gio.AppLaunchContext.IsAppLaunchContext b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> [T.Text]
    -- ^ /@uris@/: a t'GI.GLib.Structs.List.List' containing URIs to launch.
    -> Maybe (b)
    -- ^ /@context@/: a t'GI.Gio.Objects.AppLaunchContext.AppLaunchContext' or 'P.Nothing'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is done
    -> m ()
appInfoLaunchUrisAsync :: a
-> [Text] -> Maybe b -> Maybe c -> Maybe AsyncReadyCallback -> m ()
appInfoLaunchUrisAsync appinfo :: a
appinfo uris :: [Text]
uris context :: Maybe b
context cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    [CString]
uris' <- (Text -> IO CString) -> [Text] -> IO [CString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO CString
textToCString [Text]
uris
    Ptr (GList CString)
uris'' <- [CString] -> IO (Ptr (GList CString))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [CString]
uris'
    Ptr AppLaunchContext
maybeContext <- case Maybe b
context of
        Nothing -> Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
forall a. Ptr a
nullPtr
        Just jContext :: b
jContext -> do
            Ptr AppLaunchContext
jContext' <- b -> IO (Ptr AppLaunchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jContext
            Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
jContext'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr AppInfo
-> Ptr (GList CString)
-> Ptr AppLaunchContext
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_app_info_launch_uris_async Ptr AppInfo
appinfo' Ptr (GList CString)
uris'' Ptr AppLaunchContext
maybeContext Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
context b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    (CString -> IO ()) -> Ptr (GList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GList (Ptr a)) -> IO ()
mapGList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GList CString)
uris''
    Ptr (GList CString) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList CString)
uris''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AppInfoLaunchUrisAsyncMethodInfo
instance (signature ~ ([T.Text] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsAppInfo a, Gio.AppLaunchContext.IsAppLaunchContext b, Gio.Cancellable.IsCancellable c) => O.MethodInfo AppInfoLaunchUrisAsyncMethodInfo a signature where
    overloadedMethod = appInfoLaunchUrisAsync

#endif

-- method AppInfo::launch_uris_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_launch_uris_finish" g_app_info_launch_uris_finish :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes a 'GI.Gio.Interfaces.AppInfo.appInfoLaunchUrisAsync' operation.
-- 
-- /Since: 2.60/
appInfoLaunchUrisFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoLaunchUrisFinish :: a -> b -> m ()
appInfoLaunchUrisFinish appinfo :: a
appinfo result_ :: b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AppInfo -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_app_info_launch_uris_finish Ptr AppInfo
appinfo' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data AppInfoLaunchUrisFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsAppInfo a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo AppInfoLaunchUrisFinishMethodInfo a signature where
    overloadedMethod = appInfoLaunchUrisFinish

#endif

-- method AppInfo::remove_supports_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_remove_supports_type" g_app_info_remove_supports_type :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    CString ->                              -- content_type : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Removes a supported type from an application, if possible.
appInfoRemoveSupportsType ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> T.Text
    -- ^ /@contentType@/: a string.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoRemoveSupportsType :: a -> Text -> m ()
appInfoRemoveSupportsType appinfo :: a
appinfo contentType :: Text
contentType = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AppInfo -> CString -> Ptr (Ptr GError) -> IO CInt
g_app_info_remove_supports_type Ptr AppInfo
appinfo' CString
contentType'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
     )

#if defined(ENABLE_OVERLOADING)
data AppInfoRemoveSupportsTypeMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoRemoveSupportsTypeMethodInfo a signature where
    overloadedMethod = appInfoRemoveSupportsType

#endif

-- method AppInfo::set_as_default_for_extension
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "extension"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "a string containing the file extension\n    (without the dot)."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_set_as_default_for_extension" g_app_info_set_as_default_for_extension :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    CString ->                              -- extension : TBasicType TFileName
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets the application as the default handler for the given file extension.
appInfoSetAsDefaultForExtension ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> [Char]
    -- ^ /@extension@/: a string containing the file extension
    --     (without the dot).
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoSetAsDefaultForExtension :: a -> [Char] -> m ()
appInfoSetAsDefaultForExtension appinfo :: a
appinfo extension :: [Char]
extension = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
extension' <- [Char] -> IO CString
stringToCString [Char]
extension
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AppInfo -> CString -> Ptr (Ptr GError) -> IO CInt
g_app_info_set_as_default_for_extension Ptr AppInfo
appinfo' CString
extension'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
extension'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
extension'
     )

#if defined(ENABLE_OVERLOADING)
data AppInfoSetAsDefaultForExtensionMethodInfo
instance (signature ~ ([Char] -> m ()), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoSetAsDefaultForExtensionMethodInfo a signature where
    overloadedMethod = appInfoSetAsDefaultForExtension

#endif

-- method AppInfo::set_as_default_for_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content type." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_set_as_default_for_type" g_app_info_set_as_default_for_type :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    CString ->                              -- content_type : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets the application as the default handler for a given type.
appInfoSetAsDefaultForType ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> T.Text
    -- ^ /@contentType@/: the content type.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoSetAsDefaultForType :: a -> Text -> m ()
appInfoSetAsDefaultForType appinfo :: a
appinfo contentType :: Text
contentType = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AppInfo -> CString -> Ptr (Ptr GError) -> IO CInt
g_app_info_set_as_default_for_type Ptr AppInfo
appinfo' CString
contentType'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
     )

#if defined(ENABLE_OVERLOADING)
data AppInfoSetAsDefaultForTypeMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoSetAsDefaultForTypeMethodInfo a signature where
    overloadedMethod = appInfoSetAsDefaultForType

#endif

-- method AppInfo::set_as_last_used_for_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content type." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_set_as_last_used_for_type" g_app_info_set_as_last_used_for_type :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    CString ->                              -- content_type : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Sets the application as the last used application for a given type.
-- This will make the application appear as first in the list returned
-- by 'GI.Gio.Functions.appInfoGetRecommendedForType', regardless of the default
-- application for that content type.
appInfoSetAsLastUsedForType ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> T.Text
    -- ^ /@contentType@/: the content type.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoSetAsLastUsedForType :: a -> Text -> m ()
appInfoSetAsLastUsedForType appinfo :: a
appinfo contentType :: Text
contentType = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AppInfo -> CString -> Ptr (Ptr GError) -> IO CInt
g_app_info_set_as_last_used_for_type Ptr AppInfo
appinfo' CString
contentType'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
     )

#if defined(ENABLE_OVERLOADING)
data AppInfoSetAsLastUsedForTypeMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoSetAsLastUsedForTypeMethodInfo a signature where
    overloadedMethod = appInfoSetAsLastUsedForType

#endif

-- method AppInfo::should_show
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_should_show" g_app_info_should_show :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CInt

-- | Checks if the application info should be shown in menus that
-- list available applications.
appInfoShouldShow ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@appinfo@/ should be shown, 'P.False' otherwise.
appInfoShouldShow :: a -> m Bool
appInfoShouldShow appinfo :: a
appinfo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CInt
result <- Ptr AppInfo -> IO CInt
g_app_info_should_show Ptr AppInfo
appinfo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoShouldShowMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoShouldShowMethodInfo a signature where
    overloadedMethod = appInfoShouldShow

#endif

-- method AppInfo::supports_files
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_supports_files" g_app_info_supports_files :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CInt

-- | Checks if the application accepts files as arguments.
appInfoSupportsFiles ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@appinfo@/ supports files.
appInfoSupportsFiles :: a -> m Bool
appInfoSupportsFiles appinfo :: a
appinfo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CInt
result <- Ptr AppInfo -> IO CInt
g_app_info_supports_files Ptr AppInfo
appinfo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoSupportsFilesMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoSupportsFilesMethodInfo a signature where
    overloadedMethod = appInfoSupportsFiles

#endif

-- method AppInfo::supports_uris
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "appinfo"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAppInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_supports_uris" g_app_info_supports_uris :: 
    Ptr AppInfo ->                          -- appinfo : TInterface (Name {namespace = "Gio", name = "AppInfo"})
    IO CInt

-- | Checks if the application supports reading files and directories from URIs.
appInfoSupportsUris ::
    (B.CallStack.HasCallStack, MonadIO m, IsAppInfo a) =>
    a
    -- ^ /@appinfo@/: a t'GI.Gio.Interfaces.AppInfo.AppInfo'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@appinfo@/ supports URIs.
appInfoSupportsUris :: a -> m Bool
appInfoSupportsUris appinfo :: a
appinfo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AppInfo
appinfo' <- a -> IO (Ptr AppInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
appinfo
    CInt
result <- Ptr AppInfo -> IO CInt
g_app_info_supports_uris Ptr AppInfo
appinfo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
appinfo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AppInfoSupportsUrisMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAppInfo a) => O.MethodInfo AppInfoSupportsUrisMethodInfo a signature where
    overloadedMethod = appInfoSupportsUris

#endif

-- method AppInfo::create_from_commandline
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "commandline"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the commandline to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "application_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the application name, or %NULL to use @commandline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppInfoCreateFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "flags that can specify details of the created #GAppInfo"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "AppInfo" })
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_create_from_commandline" g_app_info_create_from_commandline :: 
    CString ->                              -- commandline : TBasicType TFileName
    CString ->                              -- application_name : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "AppInfoCreateFlags"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr AppInfo)

-- | Creates a new t'GI.Gio.Interfaces.AppInfo.AppInfo' from the given information.
-- 
-- Note that for /@commandline@/, the quoting rules of the Exec key of the
-- <http://freedesktop.org/Standards/desktop-entry-spec freedesktop.org Desktop Entry Specification>
-- are applied. For example, if the /@commandline@/ contains
-- percent-encoded URIs, the percent-character must be doubled in order to prevent it from
-- being swallowed by Exec key unquoting. See the specification for exact quoting rules.
appInfoCreateFromCommandline ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@commandline@/: the commandline to use
    -> Maybe (T.Text)
    -- ^ /@applicationName@/: the application name, or 'P.Nothing' to use /@commandline@/
    -> [Gio.Flags.AppInfoCreateFlags]
    -- ^ /@flags@/: flags that can specify details of the created t'GI.Gio.Interfaces.AppInfo.AppInfo'
    -> m AppInfo
    -- ^ __Returns:__ new t'GI.Gio.Interfaces.AppInfo.AppInfo' for given command. /(Can throw 'Data.GI.Base.GError.GError')/
appInfoCreateFromCommandline :: [Char] -> Maybe Text -> [AppInfoCreateFlags] -> m AppInfo
appInfoCreateFromCommandline commandline :: [Char]
commandline applicationName :: Maybe Text
applicationName flags :: [AppInfoCreateFlags]
flags = IO AppInfo -> m AppInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppInfo -> m AppInfo) -> IO AppInfo -> m AppInfo
forall a b. (a -> b) -> a -> b
$ do
    CString
commandline' <- [Char] -> IO CString
stringToCString [Char]
commandline
    CString
maybeApplicationName <- case Maybe Text
applicationName of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jApplicationName :: Text
jApplicationName -> do
            CString
jApplicationName' <- Text -> IO CString
textToCString Text
jApplicationName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jApplicationName'
    let flags' :: CUInt
flags' = [AppInfoCreateFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [AppInfoCreateFlags]
flags
    IO AppInfo -> IO () -> IO AppInfo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr AppInfo
result <- (Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo))
-> (Ptr (Ptr GError) -> IO (Ptr AppInfo)) -> IO (Ptr AppInfo)
forall a b. (a -> b) -> a -> b
$ CString -> CString -> CUInt -> Ptr (Ptr GError) -> IO (Ptr AppInfo)
g_app_info_create_from_commandline CString
commandline' CString
maybeApplicationName CUInt
flags'
        Text -> Ptr AppInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoCreateFromCommandline" Ptr AppInfo
result
        AppInfo
result' <- ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
AppInfo) Ptr AppInfo
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commandline'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeApplicationName
        AppInfo -> IO AppInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AppInfo
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commandline'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeApplicationName
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::get_all
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gio" , name = "AppInfo" }))
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_all" g_app_info_get_all :: 
    IO (Ptr (GList (Ptr AppInfo)))

-- | Gets a list of all of the applications currently registered
-- on this system.
-- 
-- For desktop files, this includes applications that have
-- @NoDisplay=true@ set or are excluded from display by means
-- of @OnlyShowIn@ or @NotShowIn@. See 'GI.Gio.Interfaces.AppInfo.appInfoShouldShow'.
-- The returned list does not include applications which have
-- the @Hidden@ key set.
appInfoGetAll ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m [AppInfo]
    -- ^ __Returns:__ a newly allocated t'GI.GLib.Structs.List.List' of references to @/GAppInfos/@.
appInfoGetAll :: m [AppInfo]
appInfoGetAll  = IO [AppInfo] -> m [AppInfo]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AppInfo] -> m [AppInfo]) -> IO [AppInfo] -> m [AppInfo]
forall a b. (a -> b) -> a -> b
$ do
    Ptr (GList (Ptr AppInfo))
result <- IO (Ptr (GList (Ptr AppInfo)))
g_app_info_get_all
    [Ptr AppInfo]
result' <- Ptr (GList (Ptr AppInfo)) -> IO [Ptr AppInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr AppInfo))
result
    [AppInfo]
result'' <- (Ptr AppInfo -> IO AppInfo) -> [Ptr AppInfo] -> IO [AppInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
AppInfo) [Ptr AppInfo]
result'
    Ptr (GList (Ptr AppInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr AppInfo))
result
    [AppInfo] -> IO [AppInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [AppInfo]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::get_all_for_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content type to find a #GAppInfo for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gio" , name = "AppInfo" }))
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_all_for_type" g_app_info_get_all_for_type :: 
    CString ->                              -- content_type : TBasicType TUTF8
    IO (Ptr (GList (Ptr AppInfo)))

-- | Gets a list of all @/GAppInfos/@ for a given content type,
-- including the recommended and fallback @/GAppInfos/@. See
-- 'GI.Gio.Functions.appInfoGetRecommendedForType' and
-- 'GI.Gio.Functions.appInfoGetFallbackForType'.
appInfoGetAllForType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@contentType@/: the content type to find a t'GI.Gio.Interfaces.AppInfo.AppInfo' for
    -> m [AppInfo]
    -- ^ __Returns:__ t'GI.GLib.Structs.List.List' of @/GAppInfos/@
    --     for given /@contentType@/ or 'P.Nothing' on error.
appInfoGetAllForType :: Text -> m [AppInfo]
appInfoGetAllForType contentType :: Text
contentType = IO [AppInfo] -> m [AppInfo]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AppInfo] -> m [AppInfo]) -> IO [AppInfo] -> m [AppInfo]
forall a b. (a -> b) -> a -> b
$ do
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    Ptr (GList (Ptr AppInfo))
result <- CString -> IO (Ptr (GList (Ptr AppInfo)))
g_app_info_get_all_for_type CString
contentType'
    [Ptr AppInfo]
result' <- Ptr (GList (Ptr AppInfo)) -> IO [Ptr AppInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr AppInfo))
result
    [AppInfo]
result'' <- (Ptr AppInfo -> IO AppInfo) -> [Ptr AppInfo] -> IO [AppInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
AppInfo) [Ptr AppInfo]
result'
    Ptr (GList (Ptr AppInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr AppInfo))
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    [AppInfo] -> IO [AppInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [AppInfo]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::get_default_for_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content type to find a #GAppInfo for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "must_support_uris"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "if %TRUE, the #GAppInfo is expected to\n    support URIs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "AppInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_default_for_type" g_app_info_get_default_for_type :: 
    CString ->                              -- content_type : TBasicType TUTF8
    CInt ->                                 -- must_support_uris : TBasicType TBoolean
    IO (Ptr AppInfo)

-- | Gets the default t'GI.Gio.Interfaces.AppInfo.AppInfo' for a given content type.
appInfoGetDefaultForType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@contentType@/: the content type to find a t'GI.Gio.Interfaces.AppInfo.AppInfo' for
    -> Bool
    -- ^ /@mustSupportUris@/: if 'P.True', the t'GI.Gio.Interfaces.AppInfo.AppInfo' is expected to
    --     support URIs
    -> m AppInfo
    -- ^ __Returns:__ t'GI.Gio.Interfaces.AppInfo.AppInfo' for given /@contentType@/ or
    --     'P.Nothing' on error.
appInfoGetDefaultForType :: Text -> Bool -> m AppInfo
appInfoGetDefaultForType contentType :: Text
contentType mustSupportUris :: Bool
mustSupportUris = IO AppInfo -> m AppInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppInfo -> m AppInfo) -> IO AppInfo -> m AppInfo
forall a b. (a -> b) -> a -> b
$ do
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    let mustSupportUris' :: CInt
mustSupportUris' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
mustSupportUris
    Ptr AppInfo
result <- CString -> CInt -> IO (Ptr AppInfo)
g_app_info_get_default_for_type CString
contentType' CInt
mustSupportUris'
    Text -> Ptr AppInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetDefaultForType" Ptr AppInfo
result
    AppInfo
result' <- ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
AppInfo) Ptr AppInfo
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    AppInfo -> IO AppInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AppInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::get_default_for_uri_scheme
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri_scheme"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a string containing a URI scheme."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "AppInfo" })
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_default_for_uri_scheme" g_app_info_get_default_for_uri_scheme :: 
    CString ->                              -- uri_scheme : TBasicType TUTF8
    IO (Ptr AppInfo)

-- | Gets the default application for handling URIs with
-- the given URI scheme. A URI scheme is the initial part
-- of the URI, up to but not including the \':\', e.g. \"http\",
-- \"ftp\" or \"sip\".
appInfoGetDefaultForUriScheme ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@uriScheme@/: a string containing a URI scheme.
    -> m AppInfo
    -- ^ __Returns:__ t'GI.Gio.Interfaces.AppInfo.AppInfo' for given /@uriScheme@/ or 'P.Nothing' on error.
appInfoGetDefaultForUriScheme :: Text -> m AppInfo
appInfoGetDefaultForUriScheme uriScheme :: Text
uriScheme = IO AppInfo -> m AppInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AppInfo -> m AppInfo) -> IO AppInfo -> m AppInfo
forall a b. (a -> b) -> a -> b
$ do
    CString
uriScheme' <- Text -> IO CString
textToCString Text
uriScheme
    Ptr AppInfo
result <- CString -> IO (Ptr AppInfo)
g_app_info_get_default_for_uri_scheme CString
uriScheme'
    Text -> Ptr AppInfo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "appInfoGetDefaultForUriScheme" Ptr AppInfo
result
    AppInfo
result' <- ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
AppInfo) Ptr AppInfo
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uriScheme'
    AppInfo -> IO AppInfo
forall (m :: * -> *) a. Monad m => a -> m a
return AppInfo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::get_fallback_for_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content type to find a #GAppInfo for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gio" , name = "AppInfo" }))
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_fallback_for_type" g_app_info_get_fallback_for_type :: 
    CString ->                              -- content_type : TBasicType TUTF8
    IO (Ptr (GList (Ptr AppInfo)))

-- | Gets a list of fallback @/GAppInfos/@ for a given content type, i.e.
-- those applications which claim to support the given content type
-- by MIME type subclassing and not directly.
-- 
-- /Since: 2.28/
appInfoGetFallbackForType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@contentType@/: the content type to find a t'GI.Gio.Interfaces.AppInfo.AppInfo' for
    -> m [AppInfo]
    -- ^ __Returns:__ t'GI.GLib.Structs.List.List' of @/GAppInfos/@
    --     for given /@contentType@/ or 'P.Nothing' on error.
appInfoGetFallbackForType :: Text -> m [AppInfo]
appInfoGetFallbackForType contentType :: Text
contentType = IO [AppInfo] -> m [AppInfo]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AppInfo] -> m [AppInfo]) -> IO [AppInfo] -> m [AppInfo]
forall a b. (a -> b) -> a -> b
$ do
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    Ptr (GList (Ptr AppInfo))
result <- CString -> IO (Ptr (GList (Ptr AppInfo)))
g_app_info_get_fallback_for_type CString
contentType'
    [Ptr AppInfo]
result' <- Ptr (GList (Ptr AppInfo)) -> IO [Ptr AppInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr AppInfo))
result
    [AppInfo]
result'' <- (Ptr AppInfo -> IO AppInfo) -> [Ptr AppInfo] -> IO [AppInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
AppInfo) [Ptr AppInfo]
result'
    Ptr (GList (Ptr AppInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr AppInfo))
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    [AppInfo] -> IO [AppInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [AppInfo]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::get_recommended_for_type
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content type to find a #GAppInfo for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList (TInterface Name { namespace = "Gio" , name = "AppInfo" }))
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_get_recommended_for_type" g_app_info_get_recommended_for_type :: 
    CString ->                              -- content_type : TBasicType TUTF8
    IO (Ptr (GList (Ptr AppInfo)))

-- | Gets a list of recommended @/GAppInfos/@ for a given content type, i.e.
-- those applications which claim to support the given content type exactly,
-- and not by MIME type subclassing.
-- Note that the first application of the list is the last used one, i.e.
-- the last one for which 'GI.Gio.Interfaces.AppInfo.appInfoSetAsLastUsedForType' has been
-- called.
-- 
-- /Since: 2.28/
appInfoGetRecommendedForType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@contentType@/: the content type to find a t'GI.Gio.Interfaces.AppInfo.AppInfo' for
    -> m [AppInfo]
    -- ^ __Returns:__ t'GI.GLib.Structs.List.List' of @/GAppInfos/@
    --     for given /@contentType@/ or 'P.Nothing' on error.
appInfoGetRecommendedForType :: Text -> m [AppInfo]
appInfoGetRecommendedForType contentType :: Text
contentType = IO [AppInfo] -> m [AppInfo]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AppInfo] -> m [AppInfo]) -> IO [AppInfo] -> m [AppInfo]
forall a b. (a -> b) -> a -> b
$ do
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    Ptr (GList (Ptr AppInfo))
result <- CString -> IO (Ptr (GList (Ptr AppInfo)))
g_app_info_get_recommended_for_type CString
contentType'
    [Ptr AppInfo]
result' <- Ptr (GList (Ptr AppInfo)) -> IO [Ptr AppInfo]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr AppInfo))
result
    [AppInfo]
result'' <- (Ptr AppInfo -> IO AppInfo) -> [Ptr AppInfo] -> IO [AppInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr AppInfo -> AppInfo) -> Ptr AppInfo -> IO AppInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr AppInfo -> AppInfo
AppInfo) [Ptr AppInfo]
result'
    Ptr (GList (Ptr AppInfo)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr AppInfo))
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    [AppInfo] -> IO [AppInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [AppInfo]
result''

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::launch_default_for_uri
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the uri to show" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppLaunchContext" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an optional #GAppLaunchContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_launch_default_for_uri" g_app_info_launch_default_for_uri :: 
    CString ->                              -- uri : TBasicType TUTF8
    Ptr Gio.AppLaunchContext.AppLaunchContext -> -- context : TInterface (Name {namespace = "Gio", name = "AppLaunchContext"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Utility function that launches the default application
-- registered to handle the specified uri. Synchronous I\/O
-- is done on the uri to detect the type of the file if
-- required.
-- 
-- The D-Bus–activated applications don\'t have to be started if your application
-- terminates too soon after this function. To prevent this, use
-- 'GI.Gio.Functions.appInfoLaunchDefaultForUri' instead.
appInfoLaunchDefaultForUri ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AppLaunchContext.IsAppLaunchContext a) =>
    T.Text
    -- ^ /@uri@/: the uri to show
    -> Maybe (a)
    -- ^ /@context@/: an optional t'GI.Gio.Objects.AppLaunchContext.AppLaunchContext'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoLaunchDefaultForUri :: Text -> Maybe a -> m ()
appInfoLaunchDefaultForUri uri :: Text
uri context :: Maybe a
context = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr AppLaunchContext
maybeContext <- case Maybe a
context of
        Nothing -> Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
forall a. Ptr a
nullPtr
        Just jContext :: a
jContext -> do
            Ptr AppLaunchContext
jContext' <- a -> IO (Ptr AppLaunchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jContext
            Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
jContext'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ CString -> Ptr AppLaunchContext -> Ptr (Ptr GError) -> IO CInt
g_app_info_launch_default_for_uri CString
uri' Ptr AppLaunchContext
maybeContext
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
context a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::launch_default_for_uri_async
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "uri"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the uri to show" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AppLaunchContext" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an optional #GAppLaunchContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GAsyncReadyCallback to call when the request is done"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_launch_default_for_uri_async" g_app_info_launch_default_for_uri_async :: 
    CString ->                              -- uri : TBasicType TUTF8
    Ptr Gio.AppLaunchContext.AppLaunchContext -> -- context : TInterface (Name {namespace = "Gio", name = "AppLaunchContext"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Async version of 'GI.Gio.Functions.appInfoLaunchDefaultForUri'.
-- 
-- This version is useful if you are interested in receiving
-- error information in the case where the application is
-- sandboxed and the portal may present an application chooser
-- dialog to the user.
-- 
-- This is also useful if you want to be sure that the D-Bus–activated
-- applications are really started before termination and if you are interested
-- in receiving error information from their activation.
-- 
-- /Since: 2.50/
appInfoLaunchDefaultForUriAsync ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AppLaunchContext.IsAppLaunchContext a, Gio.Cancellable.IsCancellable b) =>
    T.Text
    -- ^ /@uri@/: the uri to show
    -> Maybe (a)
    -- ^ /@context@/: an optional t'GI.Gio.Objects.AppLaunchContext.AppLaunchContext'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback' to call when the request is done
    -> m ()
appInfoLaunchDefaultForUriAsync :: Text -> Maybe a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
appInfoLaunchDefaultForUriAsync uri :: Text
uri context :: Maybe a
context cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
uri' <- Text -> IO CString
textToCString Text
uri
    Ptr AppLaunchContext
maybeContext <- case Maybe a
context of
        Nothing -> Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
forall a. Ptr a
nullPtr
        Just jContext :: a
jContext -> do
            Ptr AppLaunchContext
jContext' <- a -> IO (Ptr AppLaunchContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jContext
            Ptr AppLaunchContext -> IO (Ptr AppLaunchContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AppLaunchContext
jContext'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    CString
-> Ptr AppLaunchContext
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_app_info_launch_default_for_uri_async CString
uri' Ptr AppLaunchContext
maybeContext Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
context a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uri'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::launch_default_for_uri_finish
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_app_info_launch_default_for_uri_finish" g_app_info_launch_default_for_uri_finish :: 
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes an asynchronous launch-default-for-uri operation.
-- 
-- /Since: 2.50/
appInfoLaunchDefaultForUriFinish ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.AsyncResult.IsAsyncResult a) =>
    a
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
appInfoLaunchDefaultForUriFinish :: a -> m ()
appInfoLaunchDefaultForUriFinish result_ :: a
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AsyncResult
result_' <- a -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_app_info_launch_default_for_uri_finish Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method AppInfo::reset_type_associations
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a content type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_app_info_reset_type_associations" g_app_info_reset_type_associations :: 
    CString ->                              -- content_type : TBasicType TUTF8
    IO ()

-- | Removes all changes to the type associations done by
-- 'GI.Gio.Interfaces.AppInfo.appInfoSetAsDefaultForType',
-- 'GI.Gio.Interfaces.AppInfo.appInfoSetAsDefaultForExtension',
-- 'GI.Gio.Interfaces.AppInfo.appInfoAddSupportsType' or
-- 'GI.Gio.Interfaces.AppInfo.appInfoRemoveSupportsType'.
-- 
-- /Since: 2.20/
appInfoResetTypeAssociations ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@contentType@/: a content type
    -> m ()
appInfoResetTypeAssociations :: Text -> m ()
appInfoResetTypeAssociations contentType :: Text
contentType = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    CString -> IO ()
g_app_info_reset_type_associations CString
contentType'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif