{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.Dazzle.Objects.DirectoryReaper
    ( 

-- * Exported types
    DirectoryReaper(..)                     ,
    IsDirectoryReaper                       ,
    toDirectoryReaper                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addDirectory]("GI.Dazzle.Objects.DirectoryReaper#g:method:addDirectory"), [addFile]("GI.Dazzle.Objects.DirectoryReaper#g:method:addFile"), [addGlob]("GI.Dazzle.Objects.DirectoryReaper#g:method:addGlob"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [execute]("GI.Dazzle.Objects.DirectoryReaper#g:method:execute"), [executeAsync]("GI.Dazzle.Objects.DirectoryReaper#g:method:executeAsync"), [executeFinish]("GI.Dazzle.Objects.DirectoryReaper#g:method:executeFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [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)
    ResolveDirectoryReaperMethod            ,
#endif

-- ** addDirectory #method:addDirectory#

#if defined(ENABLE_OVERLOADING)
    DirectoryReaperAddDirectoryMethodInfo   ,
#endif
    directoryReaperAddDirectory             ,


-- ** addFile #method:addFile#

#if defined(ENABLE_OVERLOADING)
    DirectoryReaperAddFileMethodInfo        ,
#endif
    directoryReaperAddFile                  ,


-- ** addGlob #method:addGlob#

#if defined(ENABLE_OVERLOADING)
    DirectoryReaperAddGlobMethodInfo        ,
#endif
    directoryReaperAddGlob                  ,


-- ** execute #method:execute#

#if defined(ENABLE_OVERLOADING)
    DirectoryReaperExecuteMethodInfo        ,
#endif
    directoryReaperExecute                  ,


-- ** executeAsync #method:executeAsync#

#if defined(ENABLE_OVERLOADING)
    DirectoryReaperExecuteAsyncMethodInfo   ,
#endif
    directoryReaperExecuteAsync             ,


-- ** executeFinish #method:executeFinish#

#if defined(ENABLE_OVERLOADING)
    DirectoryReaperExecuteFinishMethodInfo  ,
#endif
    directoryReaperExecuteFinish            ,


-- ** new #method:new#

    directoryReaperNew                      ,




 -- * Signals


-- ** removeFile #signal:removeFile#

    DirectoryReaperRemoveFileCallback       ,
#if defined(ENABLE_OVERLOADING)
    DirectoryReaperRemoveFileSignalInfo     ,
#endif
    afterDirectoryReaperRemoveFile          ,
    onDirectoryReaperRemoveFile             ,




    ) 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.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import 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 qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

#endif

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

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

foreign import ccall "dzl_directory_reaper_get_type"
    c_dzl_directory_reaper_get_type :: IO B.Types.GType

instance B.Types.TypedObject DirectoryReaper where
    glibType :: IO GType
glibType = IO GType
c_dzl_directory_reaper_get_type

instance B.Types.GObject DirectoryReaper

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveDirectoryReaperMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveDirectoryReaperMethod "addDirectory" o = DirectoryReaperAddDirectoryMethodInfo
    ResolveDirectoryReaperMethod "addFile" o = DirectoryReaperAddFileMethodInfo
    ResolveDirectoryReaperMethod "addGlob" o = DirectoryReaperAddGlobMethodInfo
    ResolveDirectoryReaperMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveDirectoryReaperMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveDirectoryReaperMethod "execute" o = DirectoryReaperExecuteMethodInfo
    ResolveDirectoryReaperMethod "executeAsync" o = DirectoryReaperExecuteAsyncMethodInfo
    ResolveDirectoryReaperMethod "executeFinish" o = DirectoryReaperExecuteFinishMethodInfo
    ResolveDirectoryReaperMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveDirectoryReaperMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveDirectoryReaperMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveDirectoryReaperMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveDirectoryReaperMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveDirectoryReaperMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveDirectoryReaperMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveDirectoryReaperMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveDirectoryReaperMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveDirectoryReaperMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveDirectoryReaperMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveDirectoryReaperMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveDirectoryReaperMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveDirectoryReaperMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveDirectoryReaperMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveDirectoryReaperMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveDirectoryReaperMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveDirectoryReaperMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveDirectoryReaperMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveDirectoryReaperMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveDirectoryReaperMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal DirectoryReaper::remove-file
-- | The \"remove-file\" signal is emitted for each file that is removed by the
-- t'GI.Dazzle.Objects.DirectoryReaper.DirectoryReaper' instance. This may be useful if you want to show the
-- user what was processed by the reaper.
-- 
-- /Since: 3.32/
type DirectoryReaperRemoveFileCallback =
    Gio.File.File
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'
    -> IO ()

type C_DirectoryReaperRemoveFileCallback =
    Ptr DirectoryReaper ->                  -- object
    Ptr Gio.File.File ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_DirectoryReaperRemoveFileCallback`.
foreign import ccall "wrapper"
    mk_DirectoryReaperRemoveFileCallback :: C_DirectoryReaperRemoveFileCallback -> IO (FunPtr C_DirectoryReaperRemoveFileCallback)

wrap_DirectoryReaperRemoveFileCallback :: 
    GObject a => (a -> DirectoryReaperRemoveFileCallback) ->
    C_DirectoryReaperRemoveFileCallback
wrap_DirectoryReaperRemoveFileCallback :: forall a.
GObject a =>
(a -> DirectoryReaperRemoveFileCallback)
-> C_DirectoryReaperRemoveFileCallback
wrap_DirectoryReaperRemoveFileCallback a -> DirectoryReaperRemoveFileCallback
gi'cb Ptr DirectoryReaper
gi'selfPtr Ptr File
file Ptr ()
_ = do
    File
file' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
file
    Ptr DirectoryReaper -> (DirectoryReaper -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr DirectoryReaper
gi'selfPtr ((DirectoryReaper -> IO ()) -> IO ())
-> (DirectoryReaper -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \DirectoryReaper
gi'self -> a -> DirectoryReaperRemoveFileCallback
gi'cb (DirectoryReaper -> a
forall a b. Coercible a b => a -> b
Coerce.coerce DirectoryReaper
gi'self)  File
file'


-- | Connect a signal handler for the [removeFile](#signal:removeFile) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' directoryReaper #removeFile callback
-- @
-- 
-- 
onDirectoryReaperRemoveFile :: (IsDirectoryReaper a, MonadIO m) => a -> ((?self :: a) => DirectoryReaperRemoveFileCallback) -> m SignalHandlerId
onDirectoryReaperRemoveFile :: forall a (m :: * -> *).
(IsDirectoryReaper a, MonadIO m) =>
a
-> ((?self::a) => DirectoryReaperRemoveFileCallback)
-> m SignalHandlerId
onDirectoryReaperRemoveFile a
obj (?self::a) => DirectoryReaperRemoveFileCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DirectoryReaperRemoveFileCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DirectoryReaperRemoveFileCallback
DirectoryReaperRemoveFileCallback
cb
    let wrapped' :: C_DirectoryReaperRemoveFileCallback
wrapped' = (a -> DirectoryReaperRemoveFileCallback)
-> C_DirectoryReaperRemoveFileCallback
forall a.
GObject a =>
(a -> DirectoryReaperRemoveFileCallback)
-> C_DirectoryReaperRemoveFileCallback
wrap_DirectoryReaperRemoveFileCallback a -> DirectoryReaperRemoveFileCallback
wrapped
    FunPtr C_DirectoryReaperRemoveFileCallback
wrapped'' <- C_DirectoryReaperRemoveFileCallback
-> IO (FunPtr C_DirectoryReaperRemoveFileCallback)
mk_DirectoryReaperRemoveFileCallback C_DirectoryReaperRemoveFileCallback
wrapped'
    a
-> Text
-> FunPtr C_DirectoryReaperRemoveFileCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"remove-file" FunPtr C_DirectoryReaperRemoveFileCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [removeFile](#signal:removeFile) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' directoryReaper #removeFile callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterDirectoryReaperRemoveFile :: (IsDirectoryReaper a, MonadIO m) => a -> ((?self :: a) => DirectoryReaperRemoveFileCallback) -> m SignalHandlerId
afterDirectoryReaperRemoveFile :: forall a (m :: * -> *).
(IsDirectoryReaper a, MonadIO m) =>
a
-> ((?self::a) => DirectoryReaperRemoveFileCallback)
-> m SignalHandlerId
afterDirectoryReaperRemoveFile a
obj (?self::a) => DirectoryReaperRemoveFileCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> DirectoryReaperRemoveFileCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => DirectoryReaperRemoveFileCallback
DirectoryReaperRemoveFileCallback
cb
    let wrapped' :: C_DirectoryReaperRemoveFileCallback
wrapped' = (a -> DirectoryReaperRemoveFileCallback)
-> C_DirectoryReaperRemoveFileCallback
forall a.
GObject a =>
(a -> DirectoryReaperRemoveFileCallback)
-> C_DirectoryReaperRemoveFileCallback
wrap_DirectoryReaperRemoveFileCallback a -> DirectoryReaperRemoveFileCallback
wrapped
    FunPtr C_DirectoryReaperRemoveFileCallback
wrapped'' <- C_DirectoryReaperRemoveFileCallback
-> IO (FunPtr C_DirectoryReaperRemoveFileCallback)
mk_DirectoryReaperRemoveFileCallback C_DirectoryReaperRemoveFileCallback
wrapped'
    a
-> Text
-> FunPtr C_DirectoryReaperRemoveFileCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"remove-file" FunPtr C_DirectoryReaperRemoveFileCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data DirectoryReaperRemoveFileSignalInfo
instance SignalInfo DirectoryReaperRemoveFileSignalInfo where
    type HaskellCallbackType DirectoryReaperRemoveFileSignalInfo = DirectoryReaperRemoveFileCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_DirectoryReaperRemoveFileCallback cb
        cb'' <- mk_DirectoryReaperRemoveFileCallback cb'
        connectSignalFunPtr obj "remove-file" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryReaper::remove-file"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryReaper.html#g:signal:removeFile"})

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList DirectoryReaper
type instance O.AttributeList DirectoryReaper = DirectoryReaperAttributeList
type DirectoryReaperAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method DirectoryReaper::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Dazzle" , name = "DirectoryReaper" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_directory_reaper_new" dzl_directory_reaper_new :: 
    IO (Ptr DirectoryReaper)

-- | /No description available in the introspection data./
directoryReaperNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m DirectoryReaper
directoryReaperNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m DirectoryReaper
directoryReaperNew  = IO DirectoryReaper -> m DirectoryReaper
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO DirectoryReaper -> m DirectoryReaper)
-> IO DirectoryReaper -> m DirectoryReaper
forall a b. (a -> b) -> a -> b
$ do
    Ptr DirectoryReaper
result <- IO (Ptr DirectoryReaper)
dzl_directory_reaper_new
    Text -> Ptr DirectoryReaper -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"directoryReaperNew" Ptr DirectoryReaper
result
    DirectoryReaper
result' <- ((ManagedPtr DirectoryReaper -> DirectoryReaper)
-> Ptr DirectoryReaper -> IO DirectoryReaper
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr DirectoryReaper -> DirectoryReaper
DirectoryReaper) Ptr DirectoryReaper
result
    DirectoryReaper -> IO DirectoryReaper
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DirectoryReaper
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method DirectoryReaper::add_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "DirectoryReaper" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_age"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_directory_reaper_add_directory" dzl_directory_reaper_add_directory :: 
    Ptr DirectoryReaper ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryReaper"})
    Ptr Gio.File.File ->                    -- directory : TInterface (Name {namespace = "Gio", name = "File"})
    Int64 ->                                -- min_age : TBasicType TInt64
    IO ()

-- | /No description available in the introspection data./
directoryReaperAddDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryReaper a, Gio.File.IsFile b) =>
    a
    -> b
    -> Int64
    -> m ()
directoryReaperAddDirectory :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDirectoryReaper a, IsFile b) =>
a -> b -> Int64 -> m ()
directoryReaperAddDirectory a
self b
directory Int64
minAge = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DirectoryReaper
self' <- a -> IO (Ptr DirectoryReaper)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
directory' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
directory
    Ptr DirectoryReaper -> Ptr File -> Int64 -> IO ()
dzl_directory_reaper_add_directory Ptr DirectoryReaper
self' Ptr File
directory' Int64
minAge
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
directory
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DirectoryReaperAddDirectoryMethodInfo
instance (signature ~ (b -> Int64 -> m ()), MonadIO m, IsDirectoryReaper a, Gio.File.IsFile b) => O.OverloadedMethod DirectoryReaperAddDirectoryMethodInfo a signature where
    overloadedMethod = directoryReaperAddDirectory

instance O.OverloadedMethodInfo DirectoryReaperAddDirectoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryReaper.directoryReaperAddDirectory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryReaper.html#v:directoryReaperAddDirectory"
        })


#endif

-- method DirectoryReaper::add_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "DirectoryReaper" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_age"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_directory_reaper_add_file" dzl_directory_reaper_add_file :: 
    Ptr DirectoryReaper ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryReaper"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Int64 ->                                -- min_age : TBasicType TInt64
    IO ()

-- | /No description available in the introspection data./
directoryReaperAddFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryReaper a, Gio.File.IsFile b) =>
    a
    -> b
    -> Int64
    -> m ()
directoryReaperAddFile :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDirectoryReaper a, IsFile b) =>
a -> b -> Int64 -> m ()
directoryReaperAddFile a
self b
file Int64
minAge = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DirectoryReaper
self' <- a -> IO (Ptr DirectoryReaper)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    Ptr DirectoryReaper -> Ptr File -> Int64 -> IO ()
dzl_directory_reaper_add_file Ptr DirectoryReaper
self' Ptr File
file' Int64
minAge
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DirectoryReaperAddFileMethodInfo
instance (signature ~ (b -> Int64 -> m ()), MonadIO m, IsDirectoryReaper a, Gio.File.IsFile b) => O.OverloadedMethod DirectoryReaperAddFileMethodInfo a signature where
    overloadedMethod = directoryReaperAddFile

instance O.OverloadedMethodInfo DirectoryReaperAddFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryReaper.directoryReaperAddFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryReaper.html#v:directoryReaperAddFile"
        })


#endif

-- method DirectoryReaper::add_glob
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "DirectoryReaper" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "directory"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "glob"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "min_age"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 "dzl_directory_reaper_add_glob" dzl_directory_reaper_add_glob :: 
    Ptr DirectoryReaper ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryReaper"})
    Ptr Gio.File.File ->                    -- directory : TInterface (Name {namespace = "Gio", name = "File"})
    CString ->                              -- glob : TBasicType TUTF8
    Int64 ->                                -- min_age : TBasicType TInt64
    IO ()

-- | /No description available in the introspection data./
directoryReaperAddGlob ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryReaper a, Gio.File.IsFile b) =>
    a
    -> b
    -> T.Text
    -> Int64
    -> m ()
directoryReaperAddGlob :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDirectoryReaper a, IsFile b) =>
a -> b -> Text -> Int64 -> m ()
directoryReaperAddGlob a
self b
directory Text
glob Int64
minAge = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr DirectoryReaper
self' <- a -> IO (Ptr DirectoryReaper)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
directory' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
directory
    CString
glob' <- Text -> IO CString
textToCString Text
glob
    Ptr DirectoryReaper -> Ptr File -> CString -> Int64 -> IO ()
dzl_directory_reaper_add_glob Ptr DirectoryReaper
self' Ptr File
directory' CString
glob' Int64
minAge
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
directory
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
glob'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data DirectoryReaperAddGlobMethodInfo
instance (signature ~ (b -> T.Text -> Int64 -> m ()), MonadIO m, IsDirectoryReaper a, Gio.File.IsFile b) => O.OverloadedMethod DirectoryReaperAddGlobMethodInfo a signature where
    overloadedMethod = directoryReaperAddGlob

instance O.OverloadedMethodInfo DirectoryReaperAddGlobMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryReaper.directoryReaperAddGlob",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryReaper.html#v:directoryReaperAddGlob"
        })


#endif

-- method DirectoryReaper::execute
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "DirectoryReaper" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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 "dzl_directory_reaper_execute" dzl_directory_reaper_execute :: 
    Ptr DirectoryReaper ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryReaper"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
directoryReaperExecute ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryReaper a, Gio.Cancellable.IsCancellable b) =>
    a
    -> Maybe (b)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
directoryReaperExecute :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDirectoryReaper a, IsCancellable b) =>
a -> Maybe b -> m ()
directoryReaperExecute a
self 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
    Ptr DirectoryReaper
self' <- a -> IO (Ptr DirectoryReaper)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
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
nullPtr
        Just 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 DirectoryReaper
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
dzl_directory_reaper_execute Ptr DirectoryReaper
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        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
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

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

instance O.OverloadedMethodInfo DirectoryReaperExecuteMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryReaper.directoryReaperExecute",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryReaper.html#v:directoryReaperExecute"
        })


#endif

-- method DirectoryReaper::execute_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "DirectoryReaper" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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 = Nothing , 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 = Nothing , 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 "dzl_directory_reaper_execute_async" dzl_directory_reaper_execute_async :: 
    Ptr DirectoryReaper ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryReaper"})
    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 ()

-- | /No description available in the introspection data./
directoryReaperExecuteAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryReaper a, Gio.Cancellable.IsCancellable b) =>
    a
    -> Maybe (b)
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -> m ()
directoryReaperExecuteAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDirectoryReaper a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
directoryReaperExecuteAsync a
self 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
    Ptr DirectoryReaper
self' <- a -> IO (Ptr DirectoryReaper)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
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
nullPtr
        Just 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
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 (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just 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 a. a -> IO a
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 DirectoryReaper
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
dzl_directory_reaper_execute_async Ptr DirectoryReaper
self' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    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
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo DirectoryReaperExecuteAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryReaper.directoryReaperExecuteAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryReaper.html#v:directoryReaperExecuteAsync"
        })


#endif

-- method DirectoryReaper::execute_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "DirectoryReaper" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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 "dzl_directory_reaper_execute_finish" dzl_directory_reaper_execute_finish :: 
    Ptr DirectoryReaper ->                  -- self : TInterface (Name {namespace = "Dazzle", name = "DirectoryReaper"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
directoryReaperExecuteFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsDirectoryReaper a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -> b
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
directoryReaperExecuteFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsDirectoryReaper a, IsAsyncResult b) =>
a -> b -> m ()
directoryReaperExecuteFinish a
self 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
    Ptr DirectoryReaper
self' <- a -> IO (Ptr DirectoryReaper)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    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 DirectoryReaper
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
dzl_directory_reaper_execute_finish Ptr DirectoryReaper
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

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

instance O.OverloadedMethodInfo DirectoryReaperExecuteFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Objects.DirectoryReaper.directoryReaperExecuteFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Objects-DirectoryReaper.html#v:directoryReaperExecuteFinish"
        })


#endif