{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A @GPermission@ represents the status of the caller’s permission to
-- perform a certain action.
-- 
-- You can query if the action is currently allowed and if it is
-- possible to acquire the permission so that the action will be allowed
-- in the future.
-- 
-- There is also an API to actually acquire the permission and one to
-- release it.
-- 
-- As an example, a @GPermission@ might represent the ability for the
-- user to write to a t'GI.Gio.Objects.Settings.Settings' object.  This @GPermission@ object
-- could then be used to decide if it is appropriate to show a “Click here to
-- unlock” button in a dialog and to provide the mechanism to invoke
-- when that button is clicked.

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

module GI.Gio.Objects.Permission
    ( 

-- * Exported types
    Permission(..)                          ,
    IsPermission                            ,
    toPermission                            ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [acquire]("GI.Gio.Objects.Permission#g:method:acquire"), [acquireAsync]("GI.Gio.Objects.Permission#g:method:acquireAsync"), [acquireFinish]("GI.Gio.Objects.Permission#g:method:acquireFinish"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [implUpdate]("GI.Gio.Objects.Permission#g:method:implUpdate"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [release]("GI.Gio.Objects.Permission#g:method:release"), [releaseAsync]("GI.Gio.Objects.Permission#g:method:releaseAsync"), [releaseFinish]("GI.Gio.Objects.Permission#g:method:releaseFinish"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAllowed]("GI.Gio.Objects.Permission#g:method:getAllowed"), [getCanAcquire]("GI.Gio.Objects.Permission#g:method:getCanAcquire"), [getCanRelease]("GI.Gio.Objects.Permission#g:method:getCanRelease"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolvePermissionMethod                 ,
#endif

-- ** acquire #method:acquire#

#if defined(ENABLE_OVERLOADING)
    PermissionAcquireMethodInfo             ,
#endif
    permissionAcquire                       ,


-- ** acquireAsync #method:acquireAsync#

#if defined(ENABLE_OVERLOADING)
    PermissionAcquireAsyncMethodInfo        ,
#endif
    permissionAcquireAsync                  ,


-- ** acquireFinish #method:acquireFinish#

#if defined(ENABLE_OVERLOADING)
    PermissionAcquireFinishMethodInfo       ,
#endif
    permissionAcquireFinish                 ,


-- ** getAllowed #method:getAllowed#

#if defined(ENABLE_OVERLOADING)
    PermissionGetAllowedMethodInfo          ,
#endif
    permissionGetAllowed                    ,


-- ** getCanAcquire #method:getCanAcquire#

#if defined(ENABLE_OVERLOADING)
    PermissionGetCanAcquireMethodInfo       ,
#endif
    permissionGetCanAcquire                 ,


-- ** getCanRelease #method:getCanRelease#

#if defined(ENABLE_OVERLOADING)
    PermissionGetCanReleaseMethodInfo       ,
#endif
    permissionGetCanRelease                 ,


-- ** implUpdate #method:implUpdate#

#if defined(ENABLE_OVERLOADING)
    PermissionImplUpdateMethodInfo          ,
#endif
    permissionImplUpdate                    ,


-- ** release #method:release#

#if defined(ENABLE_OVERLOADING)
    PermissionReleaseMethodInfo             ,
#endif
    permissionRelease                       ,


-- ** releaseAsync #method:releaseAsync#

#if defined(ENABLE_OVERLOADING)
    PermissionReleaseAsyncMethodInfo        ,
#endif
    permissionReleaseAsync                  ,


-- ** releaseFinish #method:releaseFinish#

#if defined(ENABLE_OVERLOADING)
    PermissionReleaseFinishMethodInfo       ,
#endif
    permissionReleaseFinish                 ,




 -- * Properties


-- ** allowed #attr:allowed#
-- | 'P.True' if the caller currently has permission to perform the action that
-- /@permission@/ represents the permission to perform.

#if defined(ENABLE_OVERLOADING)
    PermissionAllowedPropertyInfo           ,
#endif
    getPermissionAllowed                    ,
#if defined(ENABLE_OVERLOADING)
    permissionAllowed                       ,
#endif


-- ** canAcquire #attr:canAcquire#
-- | 'P.True' if it is generally possible to acquire the permission by calling
-- 'GI.Gio.Objects.Permission.permissionAcquire'.

#if defined(ENABLE_OVERLOADING)
    PermissionCanAcquirePropertyInfo        ,
#endif
    getPermissionCanAcquire                 ,
#if defined(ENABLE_OVERLOADING)
    permissionCanAcquire                    ,
#endif


-- ** canRelease #attr:canRelease#
-- | 'P.True' if it is generally possible to release the permission by calling
-- 'GI.Gio.Objects.Permission.permissionRelease'.

#if defined(ENABLE_OVERLOADING)
    PermissionCanReleasePropertyInfo        ,
#endif
    getPermissionCanRelease                 ,
#if defined(ENABLE_OVERLOADING)
    permissionCanRelease                    ,
#endif




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks
import qualified GI.GLib.Structs.PollFD as GLib.PollFD
import qualified GI.GLib.Structs.Source as GLib.Source
import qualified GI.GObject.Callbacks as GObject.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import {-# SOURCE #-} qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

#endif

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

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

foreign import ccall "g_permission_get_type"
    c_g_permission_get_type :: IO B.Types.GType

instance B.Types.TypedObject Permission where
    glibType :: IO GType
glibType = IO GType
c_g_permission_get_type

instance B.Types.GObject Permission

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

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

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

-- | Convert 'Permission' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Permission) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_g_permission_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Permission -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Permission
P.Nothing = Ptr GValue -> Ptr Permission -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr Permission
forall a. Ptr a
FP.nullPtr :: FP.Ptr Permission)
    gvalueSet_ Ptr GValue
gv (P.Just Permission
obj) = Permission -> (Ptr Permission -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Permission
obj (Ptr GValue -> Ptr Permission -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Permission)
gvalueGet_ Ptr GValue
gv = do
        ptr <- Ptr GValue -> IO (Ptr Permission)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr Permission)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newObject Permission ptr
        else return P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolvePermissionMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolvePermissionMethod "acquire" o = PermissionAcquireMethodInfo
    ResolvePermissionMethod "acquireAsync" o = PermissionAcquireAsyncMethodInfo
    ResolvePermissionMethod "acquireFinish" o = PermissionAcquireFinishMethodInfo
    ResolvePermissionMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolvePermissionMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolvePermissionMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolvePermissionMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolvePermissionMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolvePermissionMethod "implUpdate" o = PermissionImplUpdateMethodInfo
    ResolvePermissionMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolvePermissionMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolvePermissionMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolvePermissionMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolvePermissionMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolvePermissionMethod "release" o = PermissionReleaseMethodInfo
    ResolvePermissionMethod "releaseAsync" o = PermissionReleaseAsyncMethodInfo
    ResolvePermissionMethod "releaseFinish" o = PermissionReleaseFinishMethodInfo
    ResolvePermissionMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolvePermissionMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolvePermissionMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolvePermissionMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolvePermissionMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolvePermissionMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolvePermissionMethod "getAllowed" o = PermissionGetAllowedMethodInfo
    ResolvePermissionMethod "getCanAcquire" o = PermissionGetCanAcquireMethodInfo
    ResolvePermissionMethod "getCanRelease" o = PermissionGetCanReleaseMethodInfo
    ResolvePermissionMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolvePermissionMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolvePermissionMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolvePermissionMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolvePermissionMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolvePermissionMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolvePermissionMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePermissionMethod t Permission, O.OverloadedMethod info Permission p, R.HasField t Permission p) => R.HasField t Permission p where
    getField = O.overloadedMethod @info

#endif

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

#endif

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

-- | Get the value of the “@allowed@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' permission #allowed
-- @
getPermissionAllowed :: (MonadIO m, IsPermission o) => o -> m Bool
getPermissionAllowed :: forall (m :: * -> *) o. (MonadIO m, IsPermission o) => o -> m Bool
getPermissionAllowed o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"allowed"

#if defined(ENABLE_OVERLOADING)
data PermissionAllowedPropertyInfo
instance AttrInfo PermissionAllowedPropertyInfo where
    type AttrAllowedOps PermissionAllowedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint PermissionAllowedPropertyInfo = IsPermission
    type AttrSetTypeConstraint PermissionAllowedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint PermissionAllowedPropertyInfo = (~) ()
    type AttrTransferType PermissionAllowedPropertyInfo = ()
    type AttrGetType PermissionAllowedPropertyInfo = Bool
    type AttrLabel PermissionAllowedPropertyInfo = "allowed"
    type AttrOrigin PermissionAllowedPropertyInfo = Permission
    attrGet = getPermissionAllowed
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.allowed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#g:attr:allowed"
        })
#endif

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

-- | Get the value of the “@can-acquire@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' permission #canAcquire
-- @
getPermissionCanAcquire :: (MonadIO m, IsPermission o) => o -> m Bool
getPermissionCanAcquire :: forall (m :: * -> *) o. (MonadIO m, IsPermission o) => o -> m Bool
getPermissionCanAcquire o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"can-acquire"

#if defined(ENABLE_OVERLOADING)
data PermissionCanAcquirePropertyInfo
instance AttrInfo PermissionCanAcquirePropertyInfo where
    type AttrAllowedOps PermissionCanAcquirePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint PermissionCanAcquirePropertyInfo = IsPermission
    type AttrSetTypeConstraint PermissionCanAcquirePropertyInfo = (~) ()
    type AttrTransferTypeConstraint PermissionCanAcquirePropertyInfo = (~) ()
    type AttrTransferType PermissionCanAcquirePropertyInfo = ()
    type AttrGetType PermissionCanAcquirePropertyInfo = Bool
    type AttrLabel PermissionCanAcquirePropertyInfo = "can-acquire"
    type AttrOrigin PermissionCanAcquirePropertyInfo = Permission
    attrGet = getPermissionCanAcquire
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.canAcquire"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#g:attr:canAcquire"
        })
#endif

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

-- | Get the value of the “@can-release@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' permission #canRelease
-- @
getPermissionCanRelease :: (MonadIO m, IsPermission o) => o -> m Bool
getPermissionCanRelease :: forall (m :: * -> *) o. (MonadIO m, IsPermission o) => o -> m Bool
getPermissionCanRelease o
obj = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Bool
forall a. GObject a => a -> String -> IO Bool
B.Properties.getObjectPropertyBool o
obj String
"can-release"

#if defined(ENABLE_OVERLOADING)
data PermissionCanReleasePropertyInfo
instance AttrInfo PermissionCanReleasePropertyInfo where
    type AttrAllowedOps PermissionCanReleasePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint PermissionCanReleasePropertyInfo = IsPermission
    type AttrSetTypeConstraint PermissionCanReleasePropertyInfo = (~) ()
    type AttrTransferTypeConstraint PermissionCanReleasePropertyInfo = (~) ()
    type AttrTransferType PermissionCanReleasePropertyInfo = ()
    type AttrGetType PermissionCanReleasePropertyInfo = Bool
    type AttrLabel PermissionCanReleasePropertyInfo = "can-release"
    type AttrOrigin PermissionCanReleasePropertyInfo = Permission
    attrGet = getPermissionCanRelease
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.canRelease"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#g:attr:canRelease"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Permission
type instance O.AttributeList Permission = PermissionAttributeList
type PermissionAttributeList = ('[ '("allowed", PermissionAllowedPropertyInfo), '("canAcquire", PermissionCanAcquirePropertyInfo), '("canRelease", PermissionCanReleasePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
permissionAllowed :: AttrLabelProxy "allowed"
permissionAllowed = AttrLabelProxy

permissionCanAcquire :: AttrLabelProxy "canAcquire"
permissionCanAcquire = AttrLabelProxy

permissionCanRelease :: AttrLabelProxy "canRelease"
permissionCanRelease = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Permission = PermissionSignalList
type PermissionSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Permission::acquire
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "permission"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Permission" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPermission instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_permission_acquire" g_permission_acquire :: 
    Ptr Permission ->                       -- permission : TInterface (Name {namespace = "Gio", name = "Permission"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Attempts to acquire the permission represented by /@permission@/.
-- 
-- The precise method by which this happens depends on the permission
-- and the underlying authentication mechanism.  A simple example is
-- that a dialog may appear asking the user to enter their password.
-- 
-- You should check with 'GI.Gio.Objects.Permission.permissionGetCanAcquire' before calling
-- this function.
-- 
-- If the permission is acquired then 'P.True' is returned.  Otherwise,
-- 'P.False' is returned and /@error@/ is set appropriately.
-- 
-- This call is blocking, likely for a very long time (in the case that
-- user interaction is required).  See 'GI.Gio.Objects.Permission.permissionAcquireAsync' for
-- the non-blocking version.
-- 
-- /Since: 2.26/
permissionAcquire ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
permissionAcquire :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPermission a, IsCancellable b) =>
a -> Maybe b -> m ()
permissionAcquire a
permission Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ g_permission_acquire permission' maybeCancellable
        touchManagedPtr permission
        whenJust cancellable touchManagedPtr
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data PermissionAcquireMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsPermission a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PermissionAcquireMethodInfo a signature where
    overloadedMethod = permissionAcquire

instance O.OverloadedMethodInfo PermissionAcquireMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionAcquire",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionAcquire"
        })


#endif

-- method Permission::acquire_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "permission"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Permission" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPermission instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncReadyCallback to call when done"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the user data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_permission_acquire_async" g_permission_acquire_async :: 
    Ptr Permission ->                       -- permission : TInterface (Name {namespace = "Gio", name = "Permission"})
    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 ()

-- | Attempts to acquire the permission represented by /@permission@/.
-- 
-- This is the first half of the asynchronous version of
-- 'GI.Gio.Objects.Permission.permissionAcquire'.
-- 
-- /Since: 2.26/
permissionAcquireAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: the t'GI.Gio.Callbacks.AsyncReadyCallback' to call when done
    -> m ()
permissionAcquireAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPermission a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
permissionAcquireAsync a
permission Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_permission_acquire_async permission' maybeCancellable maybeCallback userData
    touchManagedPtr permission
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data PermissionAcquireAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsPermission a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PermissionAcquireAsyncMethodInfo a signature where
    overloadedMethod = permissionAcquireAsync

instance O.OverloadedMethodInfo PermissionAcquireAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionAcquireAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionAcquireAsync"
        })


#endif

-- method Permission::acquire_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "permission"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Permission" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPermission instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GAsyncResult given to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

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

-- | Collects the result of attempting to acquire the permission
-- represented by /@permission@/.
-- 
-- This is the second half of the asynchronous version of
-- 'GI.Gio.Objects.Permission.permissionAcquire'.
-- 
-- /Since: 2.26/
permissionAcquireFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' given to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
permissionAcquireFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPermission a, IsAsyncResult b) =>
a -> b -> m ()
permissionAcquireFinish a
permission b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ g_permission_acquire_finish permission' result_'
        touchManagedPtr permission
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data PermissionAcquireFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPermission a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod PermissionAcquireFinishMethodInfo a signature where
    overloadedMethod = permissionAcquireFinish

instance O.OverloadedMethodInfo PermissionAcquireFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionAcquireFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionAcquireFinish"
        })


#endif

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

foreign import ccall "g_permission_get_allowed" g_permission_get_allowed :: 
    Ptr Permission ->                       -- permission : TInterface (Name {namespace = "Gio", name = "Permission"})
    IO CInt

-- | Gets the value of the \'allowed\' property.  This property is 'P.True' if
-- the caller currently has permission to perform the action that
-- /@permission@/ represents the permission to perform.
-- 
-- /Since: 2.26/
permissionGetAllowed ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> m Bool
    -- ^ __Returns:__ the value of the \'allowed\' property
permissionGetAllowed :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPermission a) =>
a -> m Bool
permissionGetAllowed a
permission = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    result <- g_permission_get_allowed permission'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr permission
    return result'

#if defined(ENABLE_OVERLOADING)
data PermissionGetAllowedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPermission a) => O.OverloadedMethod PermissionGetAllowedMethodInfo a signature where
    overloadedMethod = permissionGetAllowed

instance O.OverloadedMethodInfo PermissionGetAllowedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionGetAllowed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionGetAllowed"
        })


#endif

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

foreign import ccall "g_permission_get_can_acquire" g_permission_get_can_acquire :: 
    Ptr Permission ->                       -- permission : TInterface (Name {namespace = "Gio", name = "Permission"})
    IO CInt

-- | Gets the value of the \'can-acquire\' property.  This property is 'P.True'
-- if it is generally possible to acquire the permission by calling
-- 'GI.Gio.Objects.Permission.permissionAcquire'.
-- 
-- /Since: 2.26/
permissionGetCanAcquire ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> m Bool
    -- ^ __Returns:__ the value of the \'can-acquire\' property
permissionGetCanAcquire :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPermission a) =>
a -> m Bool
permissionGetCanAcquire a
permission = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    result <- g_permission_get_can_acquire permission'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr permission
    return result'

#if defined(ENABLE_OVERLOADING)
data PermissionGetCanAcquireMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPermission a) => O.OverloadedMethod PermissionGetCanAcquireMethodInfo a signature where
    overloadedMethod = permissionGetCanAcquire

instance O.OverloadedMethodInfo PermissionGetCanAcquireMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionGetCanAcquire",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionGetCanAcquire"
        })


#endif

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

foreign import ccall "g_permission_get_can_release" g_permission_get_can_release :: 
    Ptr Permission ->                       -- permission : TInterface (Name {namespace = "Gio", name = "Permission"})
    IO CInt

-- | Gets the value of the \'can-release\' property.  This property is 'P.True'
-- if it is generally possible to release the permission by calling
-- 'GI.Gio.Objects.Permission.permissionRelease'.
-- 
-- /Since: 2.26/
permissionGetCanRelease ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> m Bool
    -- ^ __Returns:__ the value of the \'can-release\' property
permissionGetCanRelease :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPermission a) =>
a -> m Bool
permissionGetCanRelease a
permission = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    result <- g_permission_get_can_release permission'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr permission
    return result'

#if defined(ENABLE_OVERLOADING)
data PermissionGetCanReleaseMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsPermission a) => O.OverloadedMethod PermissionGetCanReleaseMethodInfo a signature where
    overloadedMethod = permissionGetCanRelease

instance O.OverloadedMethodInfo PermissionGetCanReleaseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionGetCanRelease",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionGetCanRelease"
        })


#endif

-- method Permission::impl_update
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "permission"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Permission" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPermission instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allowed"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value for the 'allowed' property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "can_acquire"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value for the 'can-acquire' property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "can_release"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value for the 'can-release' property"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_permission_impl_update" g_permission_impl_update :: 
    Ptr Permission ->                       -- permission : TInterface (Name {namespace = "Gio", name = "Permission"})
    CInt ->                                 -- allowed : TBasicType TBoolean
    CInt ->                                 -- can_acquire : TBasicType TBoolean
    CInt ->                                 -- can_release : TBasicType TBoolean
    IO ()

-- | This function is called by the t'GI.Gio.Objects.Permission.Permission' implementation to update
-- the properties of the permission.  You should never call this
-- function except from a t'GI.Gio.Objects.Permission.Permission' implementation.
-- 
-- GObject notify signals are generated, as appropriate.
-- 
-- /Since: 2.26/
permissionImplUpdate ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> Bool
    -- ^ /@allowed@/: the new value for the \'allowed\' property
    -> Bool
    -- ^ /@canAcquire@/: the new value for the \'can-acquire\' property
    -> Bool
    -- ^ /@canRelease@/: the new value for the \'can-release\' property
    -> m ()
permissionImplUpdate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPermission a) =>
a -> Bool -> Bool -> Bool -> m ()
permissionImplUpdate a
permission Bool
allowed Bool
canAcquire Bool
canRelease = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    let allowed' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
allowed
    let canAcquire' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
canAcquire
    let canRelease' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
canRelease
    g_permission_impl_update permission' allowed' canAcquire' canRelease'
    touchManagedPtr permission
    return ()

#if defined(ENABLE_OVERLOADING)
data PermissionImplUpdateMethodInfo
instance (signature ~ (Bool -> Bool -> Bool -> m ()), MonadIO m, IsPermission a) => O.OverloadedMethod PermissionImplUpdateMethodInfo a signature where
    overloadedMethod = permissionImplUpdate

instance O.OverloadedMethodInfo PermissionImplUpdateMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionImplUpdate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionImplUpdate"
        })


#endif

-- method Permission::release
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "permission"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Permission" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPermission instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_permission_release" g_permission_release :: 
    Ptr Permission ->                       -- permission : TInterface (Name {namespace = "Gio", name = "Permission"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Attempts to release the permission represented by /@permission@/.
-- 
-- The precise method by which this happens depends on the permission
-- and the underlying authentication mechanism.  In most cases the
-- permission will be dropped immediately without further action.
-- 
-- You should check with 'GI.Gio.Objects.Permission.permissionGetCanRelease' before calling
-- this function.
-- 
-- If the permission is released then 'P.True' is returned.  Otherwise,
-- 'P.False' is returned and /@error@/ is set appropriately.
-- 
-- This call is blocking, likely for a very long time (in the case that
-- user interaction is required).  See 'GI.Gio.Objects.Permission.permissionReleaseAsync' for
-- the non-blocking version.
-- 
-- /Since: 2.26/
permissionRelease ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
permissionRelease :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPermission a, IsCancellable b) =>
a -> Maybe b -> m ()
permissionRelease a
permission Maybe b
cancellable = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    onException (do
        _ <- propagateGError $ g_permission_release permission' maybeCancellable
        touchManagedPtr permission
        whenJust cancellable touchManagedPtr
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data PermissionReleaseMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsPermission a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PermissionReleaseMethodInfo a signature where
    overloadedMethod = permissionRelease

instance O.OverloadedMethodInfo PermissionReleaseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionRelease",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionRelease"
        })


#endif

-- method Permission::release_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "permission"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Permission" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPermission instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncReadyCallback to call when done"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the user data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_permission_release_async" g_permission_release_async :: 
    Ptr Permission ->                       -- permission : TInterface (Name {namespace = "Gio", name = "Permission"})
    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 ()

-- | Attempts to release the permission represented by /@permission@/.
-- 
-- This is the first half of the asynchronous version of
-- 'GI.Gio.Objects.Permission.permissionRelease'.
-- 
-- /Since: 2.26/
permissionReleaseAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: the t'GI.Gio.Callbacks.AsyncReadyCallback' to call when done
    -> m ()
permissionReleaseAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPermission a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
permissionReleaseAsync a
permission Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    maybeCancellable <- case cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
FP.nullPtr
        Just b
jCancellable -> do
            jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            return jCancellable'
    maybeCallback <- case callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
forall a. FunPtr a
FP.nullFunPtr
        Just AsyncReadyCallback
jCallback -> do
            ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            jCallback' <- Gio.Callbacks.mk_AsyncReadyCallback (Gio.Callbacks.wrap_AsyncReadyCallback (Just ptrcallback) (Gio.Callbacks.drop_closures_AsyncReadyCallback jCallback))
            poke ptrcallback jCallback'
            return jCallback'
    let userData = Ptr a
forall a. Ptr a
nullPtr
    g_permission_release_async permission' maybeCancellable maybeCallback userData
    touchManagedPtr permission
    whenJust cancellable touchManagedPtr
    return ()

#if defined(ENABLE_OVERLOADING)
data PermissionReleaseAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsPermission a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod PermissionReleaseAsyncMethodInfo a signature where
    overloadedMethod = permissionReleaseAsync

instance O.OverloadedMethodInfo PermissionReleaseAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionReleaseAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionReleaseAsync"
        })


#endif

-- method Permission::release_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "permission"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Permission" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GPermission instance"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #GAsyncResult given to the #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

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

-- | Collects the result of attempting to release the permission
-- represented by /@permission@/.
-- 
-- This is the second half of the asynchronous version of
-- 'GI.Gio.Objects.Permission.permissionRelease'.
-- 
-- /Since: 2.26/
permissionReleaseFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsPermission a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@permission@/: a t'GI.Gio.Objects.Permission.Permission' instance
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult' given to the t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
permissionReleaseFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsPermission a, IsAsyncResult b) =>
a -> b -> m ()
permissionReleaseFinish a
permission b
result_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    permission' <- a -> IO (Ptr Permission)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
permission
    result_' <- unsafeManagedPtrCastPtr result_
    onException (do
        _ <- propagateGError $ g_permission_release_finish permission' result_'
        touchManagedPtr permission
        touchManagedPtr result_
        return ()
     ) (do
        return ()
     )

#if defined(ENABLE_OVERLOADING)
data PermissionReleaseFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsPermission a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod PermissionReleaseFinishMethodInfo a signature where
    overloadedMethod = permissionReleaseFinish

instance O.OverloadedMethodInfo PermissionReleaseFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Permission.permissionReleaseFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.35/docs/GI-Gio-Objects-Permission.html#v:permissionReleaseFinish"
        })


#endif