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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor' is for listing the user interesting devices and volumes
-- on the computer. In other words, what a file selector or file manager
-- would show in a sidebar.
-- 
-- t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor' is not
-- [thread-default-context aware][g-main-context-push-thread-default],
-- and so should not be used other than from the main thread, with no
-- thread-default-context active.
-- 
-- In order to receive updates about volumes and mounts monitored through GVFS,
-- a main loop must be running.

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

module GI.Gio.Objects.VolumeMonitor
    ( 

-- * Exported types
    VolumeMonitor(..)                       ,
    IsVolumeMonitor                         ,
    toVolumeMonitor                         ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [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"), [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
-- [getConnectedDrives]("GI.Gio.Objects.VolumeMonitor#g:method:getConnectedDrives"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getMountForUuid]("GI.Gio.Objects.VolumeMonitor#g:method:getMountForUuid"), [getMounts]("GI.Gio.Objects.VolumeMonitor#g:method:getMounts"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getVolumeForUuid]("GI.Gio.Objects.VolumeMonitor#g:method:getVolumeForUuid"), [getVolumes]("GI.Gio.Objects.VolumeMonitor#g:method:getVolumes").
-- 
-- ==== 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)
    ResolveVolumeMonitorMethod              ,
#endif

-- ** adoptOrphanMount #method:adoptOrphanMount#

    volumeMonitorAdoptOrphanMount           ,


-- ** get #method:get#

    volumeMonitorGet                        ,


-- ** getConnectedDrives #method:getConnectedDrives#

#if defined(ENABLE_OVERLOADING)
    VolumeMonitorGetConnectedDrivesMethodInfo,
#endif
    volumeMonitorGetConnectedDrives         ,


-- ** getMountForUuid #method:getMountForUuid#

#if defined(ENABLE_OVERLOADING)
    VolumeMonitorGetMountForUuidMethodInfo  ,
#endif
    volumeMonitorGetMountForUuid            ,


-- ** getMounts #method:getMounts#

#if defined(ENABLE_OVERLOADING)
    VolumeMonitorGetMountsMethodInfo        ,
#endif
    volumeMonitorGetMounts                  ,


-- ** getVolumeForUuid #method:getVolumeForUuid#

#if defined(ENABLE_OVERLOADING)
    VolumeMonitorGetVolumeForUuidMethodInfo ,
#endif
    volumeMonitorGetVolumeForUuid           ,


-- ** getVolumes #method:getVolumes#

#if defined(ENABLE_OVERLOADING)
    VolumeMonitorGetVolumesMethodInfo       ,
#endif
    volumeMonitorGetVolumes                 ,




 -- * Signals


-- ** driveChanged #signal:driveChanged#

    VolumeMonitorDriveChangedCallback       ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorDriveChangedSignalInfo     ,
#endif
    afterVolumeMonitorDriveChanged          ,
    onVolumeMonitorDriveChanged             ,


-- ** driveConnected #signal:driveConnected#

    VolumeMonitorDriveConnectedCallback     ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorDriveConnectedSignalInfo   ,
#endif
    afterVolumeMonitorDriveConnected        ,
    onVolumeMonitorDriveConnected           ,


-- ** driveDisconnected #signal:driveDisconnected#

    VolumeMonitorDriveDisconnectedCallback  ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorDriveDisconnectedSignalInfo,
#endif
    afterVolumeMonitorDriveDisconnected     ,
    onVolumeMonitorDriveDisconnected        ,


-- ** driveEjectButton #signal:driveEjectButton#

    VolumeMonitorDriveEjectButtonCallback   ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorDriveEjectButtonSignalInfo ,
#endif
    afterVolumeMonitorDriveEjectButton      ,
    onVolumeMonitorDriveEjectButton         ,


-- ** driveStopButton #signal:driveStopButton#

    VolumeMonitorDriveStopButtonCallback    ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorDriveStopButtonSignalInfo  ,
#endif
    afterVolumeMonitorDriveStopButton       ,
    onVolumeMonitorDriveStopButton          ,


-- ** mountAdded #signal:mountAdded#

    VolumeMonitorMountAddedCallback         ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorMountAddedSignalInfo       ,
#endif
    afterVolumeMonitorMountAdded            ,
    onVolumeMonitorMountAdded               ,


-- ** mountChanged #signal:mountChanged#

    VolumeMonitorMountChangedCallback       ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorMountChangedSignalInfo     ,
#endif
    afterVolumeMonitorMountChanged          ,
    onVolumeMonitorMountChanged             ,


-- ** mountPreUnmount #signal:mountPreUnmount#

    VolumeMonitorMountPreUnmountCallback    ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorMountPreUnmountSignalInfo  ,
#endif
    afterVolumeMonitorMountPreUnmount       ,
    onVolumeMonitorMountPreUnmount          ,


-- ** mountRemoved #signal:mountRemoved#

    VolumeMonitorMountRemovedCallback       ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorMountRemovedSignalInfo     ,
#endif
    afterVolumeMonitorMountRemoved          ,
    onVolumeMonitorMountRemoved             ,


-- ** volumeAdded #signal:volumeAdded#

    VolumeMonitorVolumeAddedCallback        ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorVolumeAddedSignalInfo      ,
#endif
    afterVolumeMonitorVolumeAdded           ,
    onVolumeMonitorVolumeAdded              ,


-- ** volumeChanged #signal:volumeChanged#

    VolumeMonitorVolumeChangedCallback      ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorVolumeChangedSignalInfo    ,
#endif
    afterVolumeMonitorVolumeChanged         ,
    onVolumeMonitorVolumeChanged            ,


-- ** volumeRemoved #signal:volumeRemoved#

    VolumeMonitorVolumeRemovedCallback      ,
#if defined(ENABLE_OVERLOADING)
    VolumeMonitorVolumeRemovedSignalInfo    ,
#endif
    afterVolumeMonitorVolumeRemoved         ,
    onVolumeMonitorVolumeRemoved            ,




    ) 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 GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Drive as Gio.Drive
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Mount as Gio.Mount
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Volume as Gio.Volume

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

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

foreign import ccall "g_volume_monitor_get_type"
    c_g_volume_monitor_get_type :: IO B.Types.GType

instance B.Types.TypedObject VolumeMonitor where
    glibType :: IO GType
glibType = IO GType
c_g_volume_monitor_get_type

instance B.Types.GObject VolumeMonitor

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveVolumeMonitorMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVolumeMonitorMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveVolumeMonitorMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveVolumeMonitorMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveVolumeMonitorMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveVolumeMonitorMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveVolumeMonitorMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveVolumeMonitorMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveVolumeMonitorMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveVolumeMonitorMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveVolumeMonitorMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveVolumeMonitorMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveVolumeMonitorMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveVolumeMonitorMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveVolumeMonitorMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveVolumeMonitorMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveVolumeMonitorMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveVolumeMonitorMethod "getConnectedDrives" o = VolumeMonitorGetConnectedDrivesMethodInfo
    ResolveVolumeMonitorMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveVolumeMonitorMethod "getMountForUuid" o = VolumeMonitorGetMountForUuidMethodInfo
    ResolveVolumeMonitorMethod "getMounts" o = VolumeMonitorGetMountsMethodInfo
    ResolveVolumeMonitorMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveVolumeMonitorMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveVolumeMonitorMethod "getVolumeForUuid" o = VolumeMonitorGetVolumeForUuidMethodInfo
    ResolveVolumeMonitorMethod "getVolumes" o = VolumeMonitorGetVolumesMethodInfo
    ResolveVolumeMonitorMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveVolumeMonitorMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveVolumeMonitorMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveVolumeMonitorMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal VolumeMonitor::drive-changed
-- | Emitted when a drive changes.
type VolumeMonitorDriveChangedCallback =
    Gio.Drive.Drive
    -- ^ /@drive@/: the drive that changed
    -> IO ()

type C_VolumeMonitorDriveChangedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Drive.Drive ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorDriveChangedCallback :: 
    GObject a => (a -> VolumeMonitorDriveChangedCallback) ->
    C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveChangedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveChangedCallback a -> VolumeMonitorDriveChangedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Drive
drive Ptr ()
_ = do
    Drive
drive' <- ((ManagedPtr Drive -> Drive) -> Ptr Drive -> IO Drive
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drive -> Drive
Gio.Drive.Drive) Ptr Drive
drive
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorDriveChangedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Drive
drive'


-- | Connect a signal handler for the [driveChanged](#signal:driveChanged) 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' volumeMonitor #driveChanged callback
-- @
-- 
-- 
onVolumeMonitorDriveChanged :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveChangedCallback) -> m SignalHandlerId
onVolumeMonitorDriveChanged :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
onVolumeMonitorDriveChanged a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveChangedCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveChangedCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-changed" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [driveChanged](#signal:driveChanged) 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' volumeMonitor #driveChanged 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.
-- 
afterVolumeMonitorDriveChanged :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveChangedCallback) -> m SignalHandlerId
afterVolumeMonitorDriveChanged :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
afterVolumeMonitorDriveChanged a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveChangedCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveChangedCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-changed" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorDriveChangedSignalInfo
instance SignalInfo VolumeMonitorDriveChangedSignalInfo where
    type HaskellCallbackType VolumeMonitorDriveChangedSignalInfo = VolumeMonitorDriveChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorDriveChangedCallback cb
        cb'' <- mk_VolumeMonitorDriveChangedCallback cb'
        connectSignalFunPtr obj "drive-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::drive-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:driveChanged"})

#endif

-- signal VolumeMonitor::drive-connected
-- | Emitted when a drive is connected to the system.
type VolumeMonitorDriveConnectedCallback =
    Gio.Drive.Drive
    -- ^ /@drive@/: a t'GI.Gio.Interfaces.Drive.Drive' that was connected.
    -> IO ()

type C_VolumeMonitorDriveConnectedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Drive.Drive ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorDriveConnectedCallback :: 
    GObject a => (a -> VolumeMonitorDriveConnectedCallback) ->
    C_VolumeMonitorDriveConnectedCallback
wrap_VolumeMonitorDriveConnectedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveConnectedCallback a -> VolumeMonitorDriveChangedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Drive
drive Ptr ()
_ = do
    Drive
drive' <- ((ManagedPtr Drive -> Drive) -> Ptr Drive -> IO Drive
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drive -> Drive
Gio.Drive.Drive) Ptr Drive
drive
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorDriveChangedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Drive
drive'


-- | Connect a signal handler for the [driveConnected](#signal:driveConnected) 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' volumeMonitor #driveConnected callback
-- @
-- 
-- 
onVolumeMonitorDriveConnected :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveConnectedCallback) -> m SignalHandlerId
onVolumeMonitorDriveConnected :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
onVolumeMonitorDriveConnected a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveConnectedCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveConnectedCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-connected" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [driveConnected](#signal:driveConnected) 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' volumeMonitor #driveConnected 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.
-- 
afterVolumeMonitorDriveConnected :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveConnectedCallback) -> m SignalHandlerId
afterVolumeMonitorDriveConnected :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
afterVolumeMonitorDriveConnected a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveConnectedCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveConnectedCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-connected" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorDriveConnectedSignalInfo
instance SignalInfo VolumeMonitorDriveConnectedSignalInfo where
    type HaskellCallbackType VolumeMonitorDriveConnectedSignalInfo = VolumeMonitorDriveConnectedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorDriveConnectedCallback cb
        cb'' <- mk_VolumeMonitorDriveConnectedCallback cb'
        connectSignalFunPtr obj "drive-connected" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::drive-connected"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:driveConnected"})

#endif

-- signal VolumeMonitor::drive-disconnected
-- | Emitted when a drive is disconnected from the system.
type VolumeMonitorDriveDisconnectedCallback =
    Gio.Drive.Drive
    -- ^ /@drive@/: a t'GI.Gio.Interfaces.Drive.Drive' that was disconnected.
    -> IO ()

type C_VolumeMonitorDriveDisconnectedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Drive.Drive ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorDriveDisconnectedCallback :: 
    GObject a => (a -> VolumeMonitorDriveDisconnectedCallback) ->
    C_VolumeMonitorDriveDisconnectedCallback
wrap_VolumeMonitorDriveDisconnectedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveDisconnectedCallback a -> VolumeMonitorDriveChangedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Drive
drive Ptr ()
_ = do
    Drive
drive' <- ((ManagedPtr Drive -> Drive) -> Ptr Drive -> IO Drive
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drive -> Drive
Gio.Drive.Drive) Ptr Drive
drive
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorDriveChangedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Drive
drive'


-- | Connect a signal handler for the [driveDisconnected](#signal:driveDisconnected) 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' volumeMonitor #driveDisconnected callback
-- @
-- 
-- 
onVolumeMonitorDriveDisconnected :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveDisconnectedCallback) -> m SignalHandlerId
onVolumeMonitorDriveDisconnected :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
onVolumeMonitorDriveDisconnected a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveDisconnectedCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveDisconnectedCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-disconnected" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [driveDisconnected](#signal:driveDisconnected) 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' volumeMonitor #driveDisconnected 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.
-- 
afterVolumeMonitorDriveDisconnected :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveDisconnectedCallback) -> m SignalHandlerId
afterVolumeMonitorDriveDisconnected :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
afterVolumeMonitorDriveDisconnected a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveDisconnectedCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveDisconnectedCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-disconnected" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorDriveDisconnectedSignalInfo
instance SignalInfo VolumeMonitorDriveDisconnectedSignalInfo where
    type HaskellCallbackType VolumeMonitorDriveDisconnectedSignalInfo = VolumeMonitorDriveDisconnectedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorDriveDisconnectedCallback cb
        cb'' <- mk_VolumeMonitorDriveDisconnectedCallback cb'
        connectSignalFunPtr obj "drive-disconnected" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::drive-disconnected"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:driveDisconnected"})

#endif

-- signal VolumeMonitor::drive-eject-button
-- | Emitted when the eject button is pressed on /@drive@/.
-- 
-- /Since: 2.18/
type VolumeMonitorDriveEjectButtonCallback =
    Gio.Drive.Drive
    -- ^ /@drive@/: the drive where the eject button was pressed
    -> IO ()

type C_VolumeMonitorDriveEjectButtonCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Drive.Drive ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorDriveEjectButtonCallback :: 
    GObject a => (a -> VolumeMonitorDriveEjectButtonCallback) ->
    C_VolumeMonitorDriveEjectButtonCallback
wrap_VolumeMonitorDriveEjectButtonCallback :: forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveEjectButtonCallback a -> VolumeMonitorDriveChangedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Drive
drive Ptr ()
_ = do
    Drive
drive' <- ((ManagedPtr Drive -> Drive) -> Ptr Drive -> IO Drive
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drive -> Drive
Gio.Drive.Drive) Ptr Drive
drive
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorDriveChangedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Drive
drive'


-- | Connect a signal handler for the [driveEjectButton](#signal:driveEjectButton) 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' volumeMonitor #driveEjectButton callback
-- @
-- 
-- 
onVolumeMonitorDriveEjectButton :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveEjectButtonCallback) -> m SignalHandlerId
onVolumeMonitorDriveEjectButton :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
onVolumeMonitorDriveEjectButton a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveEjectButtonCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveEjectButtonCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-eject-button" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [driveEjectButton](#signal:driveEjectButton) 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' volumeMonitor #driveEjectButton 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.
-- 
afterVolumeMonitorDriveEjectButton :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveEjectButtonCallback) -> m SignalHandlerId
afterVolumeMonitorDriveEjectButton :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
afterVolumeMonitorDriveEjectButton a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveEjectButtonCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveEjectButtonCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-eject-button" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorDriveEjectButtonSignalInfo
instance SignalInfo VolumeMonitorDriveEjectButtonSignalInfo where
    type HaskellCallbackType VolumeMonitorDriveEjectButtonSignalInfo = VolumeMonitorDriveEjectButtonCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorDriveEjectButtonCallback cb
        cb'' <- mk_VolumeMonitorDriveEjectButtonCallback cb'
        connectSignalFunPtr obj "drive-eject-button" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::drive-eject-button"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:driveEjectButton"})

#endif

-- signal VolumeMonitor::drive-stop-button
-- | Emitted when the stop button is pressed on /@drive@/.
-- 
-- /Since: 2.22/
type VolumeMonitorDriveStopButtonCallback =
    Gio.Drive.Drive
    -- ^ /@drive@/: the drive where the stop button was pressed
    -> IO ()

type C_VolumeMonitorDriveStopButtonCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Drive.Drive ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorDriveStopButtonCallback :: 
    GObject a => (a -> VolumeMonitorDriveStopButtonCallback) ->
    C_VolumeMonitorDriveStopButtonCallback
wrap_VolumeMonitorDriveStopButtonCallback :: forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveStopButtonCallback a -> VolumeMonitorDriveChangedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Drive
drive Ptr ()
_ = do
    Drive
drive' <- ((ManagedPtr Drive -> Drive) -> Ptr Drive -> IO Drive
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Drive -> Drive
Gio.Drive.Drive) Ptr Drive
drive
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorDriveChangedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Drive
drive'


-- | Connect a signal handler for the [driveStopButton](#signal:driveStopButton) 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' volumeMonitor #driveStopButton callback
-- @
-- 
-- 
onVolumeMonitorDriveStopButton :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveStopButtonCallback) -> m SignalHandlerId
onVolumeMonitorDriveStopButton :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
onVolumeMonitorDriveStopButton a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveStopButtonCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveStopButtonCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-stop-button" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [driveStopButton](#signal:driveStopButton) 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' volumeMonitor #driveStopButton 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.
-- 
afterVolumeMonitorDriveStopButton :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorDriveStopButtonCallback) -> m SignalHandlerId
afterVolumeMonitorDriveStopButton :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorDriveChangedCallback)
-> m SignalHandlerId
afterVolumeMonitorDriveStopButton a
obj (?self::a) => VolumeMonitorDriveChangedCallback
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 -> VolumeMonitorDriveChangedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorDriveChangedCallback
VolumeMonitorDriveChangedCallback
cb
    let wrapped' :: C_VolumeMonitorDriveChangedCallback
wrapped' = (a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
forall a.
GObject a =>
(a -> VolumeMonitorDriveChangedCallback)
-> C_VolumeMonitorDriveChangedCallback
wrap_VolumeMonitorDriveStopButtonCallback a -> VolumeMonitorDriveChangedCallback
wrapped
    FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' <- C_VolumeMonitorDriveChangedCallback
-> IO (FunPtr C_VolumeMonitorDriveChangedCallback)
mk_VolumeMonitorDriveStopButtonCallback C_VolumeMonitorDriveChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorDriveChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"drive-stop-button" FunPtr C_VolumeMonitorDriveChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorDriveStopButtonSignalInfo
instance SignalInfo VolumeMonitorDriveStopButtonSignalInfo where
    type HaskellCallbackType VolumeMonitorDriveStopButtonSignalInfo = VolumeMonitorDriveStopButtonCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorDriveStopButtonCallback cb
        cb'' <- mk_VolumeMonitorDriveStopButtonCallback cb'
        connectSignalFunPtr obj "drive-stop-button" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::drive-stop-button"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:driveStopButton"})

#endif

-- signal VolumeMonitor::mount-added
-- | Emitted when a mount is added.
type VolumeMonitorMountAddedCallback =
    Gio.Mount.Mount
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount' that was added.
    -> IO ()

type C_VolumeMonitorMountAddedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Mount.Mount ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorMountAddedCallback :: 
    GObject a => (a -> VolumeMonitorMountAddedCallback) ->
    C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountAddedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountAddedCallback a -> VolumeMonitorMountAddedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Mount
mount Ptr ()
_ = do
    Mount
mount' <- ((ManagedPtr Mount -> Mount) -> Ptr Mount -> IO Mount
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Mount -> Mount
Gio.Mount.Mount) Ptr Mount
mount
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorMountAddedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Mount
mount'


-- | Connect a signal handler for the [mountAdded](#signal:mountAdded) 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' volumeMonitor #mountAdded callback
-- @
-- 
-- 
onVolumeMonitorMountAdded :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorMountAddedCallback) -> m SignalHandlerId
onVolumeMonitorMountAdded :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorMountAddedCallback)
-> m SignalHandlerId
onVolumeMonitorMountAdded a
obj (?self::a) => VolumeMonitorMountAddedCallback
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 -> VolumeMonitorMountAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorMountAddedCallback
VolumeMonitorMountAddedCallback
cb
    let wrapped' :: C_VolumeMonitorMountAddedCallback
wrapped' = (a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountAddedCallback a -> VolumeMonitorMountAddedCallback
wrapped
    FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' <- C_VolumeMonitorMountAddedCallback
-> IO (FunPtr C_VolumeMonitorMountAddedCallback)
mk_VolumeMonitorMountAddedCallback C_VolumeMonitorMountAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorMountAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mount-added" FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [mountAdded](#signal:mountAdded) 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' volumeMonitor #mountAdded 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.
-- 
afterVolumeMonitorMountAdded :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorMountAddedCallback) -> m SignalHandlerId
afterVolumeMonitorMountAdded :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorMountAddedCallback)
-> m SignalHandlerId
afterVolumeMonitorMountAdded a
obj (?self::a) => VolumeMonitorMountAddedCallback
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 -> VolumeMonitorMountAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorMountAddedCallback
VolumeMonitorMountAddedCallback
cb
    let wrapped' :: C_VolumeMonitorMountAddedCallback
wrapped' = (a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountAddedCallback a -> VolumeMonitorMountAddedCallback
wrapped
    FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' <- C_VolumeMonitorMountAddedCallback
-> IO (FunPtr C_VolumeMonitorMountAddedCallback)
mk_VolumeMonitorMountAddedCallback C_VolumeMonitorMountAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorMountAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mount-added" FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorMountAddedSignalInfo
instance SignalInfo VolumeMonitorMountAddedSignalInfo where
    type HaskellCallbackType VolumeMonitorMountAddedSignalInfo = VolumeMonitorMountAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorMountAddedCallback cb
        cb'' <- mk_VolumeMonitorMountAddedCallback cb'
        connectSignalFunPtr obj "mount-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::mount-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:mountAdded"})

#endif

-- signal VolumeMonitor::mount-changed
-- | Emitted when a mount changes.
type VolumeMonitorMountChangedCallback =
    Gio.Mount.Mount
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount' that changed.
    -> IO ()

type C_VolumeMonitorMountChangedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Mount.Mount ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorMountChangedCallback :: 
    GObject a => (a -> VolumeMonitorMountChangedCallback) ->
    C_VolumeMonitorMountChangedCallback
wrap_VolumeMonitorMountChangedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountChangedCallback a -> VolumeMonitorMountAddedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Mount
mount Ptr ()
_ = do
    Mount
mount' <- ((ManagedPtr Mount -> Mount) -> Ptr Mount -> IO Mount
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Mount -> Mount
Gio.Mount.Mount) Ptr Mount
mount
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorMountAddedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Mount
mount'


-- | Connect a signal handler for the [mountChanged](#signal:mountChanged) 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' volumeMonitor #mountChanged callback
-- @
-- 
-- 
onVolumeMonitorMountChanged :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorMountChangedCallback) -> m SignalHandlerId
onVolumeMonitorMountChanged :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorMountAddedCallback)
-> m SignalHandlerId
onVolumeMonitorMountChanged a
obj (?self::a) => VolumeMonitorMountAddedCallback
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 -> VolumeMonitorMountAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorMountAddedCallback
VolumeMonitorMountAddedCallback
cb
    let wrapped' :: C_VolumeMonitorMountAddedCallback
wrapped' = (a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountChangedCallback a -> VolumeMonitorMountAddedCallback
wrapped
    FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' <- C_VolumeMonitorMountAddedCallback
-> IO (FunPtr C_VolumeMonitorMountAddedCallback)
mk_VolumeMonitorMountChangedCallback C_VolumeMonitorMountAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorMountAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mount-changed" FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [mountChanged](#signal:mountChanged) 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' volumeMonitor #mountChanged 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.
-- 
afterVolumeMonitorMountChanged :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorMountChangedCallback) -> m SignalHandlerId
afterVolumeMonitorMountChanged :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorMountAddedCallback)
-> m SignalHandlerId
afterVolumeMonitorMountChanged a
obj (?self::a) => VolumeMonitorMountAddedCallback
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 -> VolumeMonitorMountAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorMountAddedCallback
VolumeMonitorMountAddedCallback
cb
    let wrapped' :: C_VolumeMonitorMountAddedCallback
wrapped' = (a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountChangedCallback a -> VolumeMonitorMountAddedCallback
wrapped
    FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' <- C_VolumeMonitorMountAddedCallback
-> IO (FunPtr C_VolumeMonitorMountAddedCallback)
mk_VolumeMonitorMountChangedCallback C_VolumeMonitorMountAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorMountAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mount-changed" FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorMountChangedSignalInfo
instance SignalInfo VolumeMonitorMountChangedSignalInfo where
    type HaskellCallbackType VolumeMonitorMountChangedSignalInfo = VolumeMonitorMountChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorMountChangedCallback cb
        cb'' <- mk_VolumeMonitorMountChangedCallback cb'
        connectSignalFunPtr obj "mount-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::mount-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:mountChanged"})

#endif

-- signal VolumeMonitor::mount-pre-unmount
-- | May be emitted when a mount is about to be removed.
-- 
-- This signal depends on the backend and is only emitted if
-- GIO was used to unmount.
type VolumeMonitorMountPreUnmountCallback =
    Gio.Mount.Mount
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount' that is being unmounted.
    -> IO ()

type C_VolumeMonitorMountPreUnmountCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Mount.Mount ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorMountPreUnmountCallback :: 
    GObject a => (a -> VolumeMonitorMountPreUnmountCallback) ->
    C_VolumeMonitorMountPreUnmountCallback
wrap_VolumeMonitorMountPreUnmountCallback :: forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountPreUnmountCallback a -> VolumeMonitorMountAddedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Mount
mount Ptr ()
_ = do
    Mount
mount' <- ((ManagedPtr Mount -> Mount) -> Ptr Mount -> IO Mount
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Mount -> Mount
Gio.Mount.Mount) Ptr Mount
mount
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorMountAddedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Mount
mount'


-- | Connect a signal handler for the [mountPreUnmount](#signal:mountPreUnmount) 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' volumeMonitor #mountPreUnmount callback
-- @
-- 
-- 
onVolumeMonitorMountPreUnmount :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorMountPreUnmountCallback) -> m SignalHandlerId
onVolumeMonitorMountPreUnmount :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorMountAddedCallback)
-> m SignalHandlerId
onVolumeMonitorMountPreUnmount a
obj (?self::a) => VolumeMonitorMountAddedCallback
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 -> VolumeMonitorMountAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorMountAddedCallback
VolumeMonitorMountAddedCallback
cb
    let wrapped' :: C_VolumeMonitorMountAddedCallback
wrapped' = (a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountPreUnmountCallback a -> VolumeMonitorMountAddedCallback
wrapped
    FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' <- C_VolumeMonitorMountAddedCallback
-> IO (FunPtr C_VolumeMonitorMountAddedCallback)
mk_VolumeMonitorMountPreUnmountCallback C_VolumeMonitorMountAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorMountAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mount-pre-unmount" FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [mountPreUnmount](#signal:mountPreUnmount) 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' volumeMonitor #mountPreUnmount 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.
-- 
afterVolumeMonitorMountPreUnmount :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorMountPreUnmountCallback) -> m SignalHandlerId
afterVolumeMonitorMountPreUnmount :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorMountAddedCallback)
-> m SignalHandlerId
afterVolumeMonitorMountPreUnmount a
obj (?self::a) => VolumeMonitorMountAddedCallback
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 -> VolumeMonitorMountAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorMountAddedCallback
VolumeMonitorMountAddedCallback
cb
    let wrapped' :: C_VolumeMonitorMountAddedCallback
wrapped' = (a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountPreUnmountCallback a -> VolumeMonitorMountAddedCallback
wrapped
    FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' <- C_VolumeMonitorMountAddedCallback
-> IO (FunPtr C_VolumeMonitorMountAddedCallback)
mk_VolumeMonitorMountPreUnmountCallback C_VolumeMonitorMountAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorMountAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mount-pre-unmount" FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorMountPreUnmountSignalInfo
instance SignalInfo VolumeMonitorMountPreUnmountSignalInfo where
    type HaskellCallbackType VolumeMonitorMountPreUnmountSignalInfo = VolumeMonitorMountPreUnmountCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorMountPreUnmountCallback cb
        cb'' <- mk_VolumeMonitorMountPreUnmountCallback cb'
        connectSignalFunPtr obj "mount-pre-unmount" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::mount-pre-unmount"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:mountPreUnmount"})

#endif

-- signal VolumeMonitor::mount-removed
-- | Emitted when a mount is removed.
type VolumeMonitorMountRemovedCallback =
    Gio.Mount.Mount
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount' that was removed.
    -> IO ()

type C_VolumeMonitorMountRemovedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Mount.Mount ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorMountRemovedCallback :: 
    GObject a => (a -> VolumeMonitorMountRemovedCallback) ->
    C_VolumeMonitorMountRemovedCallback
wrap_VolumeMonitorMountRemovedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountRemovedCallback a -> VolumeMonitorMountAddedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Mount
mount Ptr ()
_ = do
    Mount
mount' <- ((ManagedPtr Mount -> Mount) -> Ptr Mount -> IO Mount
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Mount -> Mount
Gio.Mount.Mount) Ptr Mount
mount
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorMountAddedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Mount
mount'


-- | Connect a signal handler for the [mountRemoved](#signal:mountRemoved) 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' volumeMonitor #mountRemoved callback
-- @
-- 
-- 
onVolumeMonitorMountRemoved :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorMountRemovedCallback) -> m SignalHandlerId
onVolumeMonitorMountRemoved :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorMountAddedCallback)
-> m SignalHandlerId
onVolumeMonitorMountRemoved a
obj (?self::a) => VolumeMonitorMountAddedCallback
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 -> VolumeMonitorMountAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorMountAddedCallback
VolumeMonitorMountAddedCallback
cb
    let wrapped' :: C_VolumeMonitorMountAddedCallback
wrapped' = (a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountRemovedCallback a -> VolumeMonitorMountAddedCallback
wrapped
    FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' <- C_VolumeMonitorMountAddedCallback
-> IO (FunPtr C_VolumeMonitorMountAddedCallback)
mk_VolumeMonitorMountRemovedCallback C_VolumeMonitorMountAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorMountAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mount-removed" FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [mountRemoved](#signal:mountRemoved) 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' volumeMonitor #mountRemoved 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.
-- 
afterVolumeMonitorMountRemoved :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorMountRemovedCallback) -> m SignalHandlerId
afterVolumeMonitorMountRemoved :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorMountAddedCallback)
-> m SignalHandlerId
afterVolumeMonitorMountRemoved a
obj (?self::a) => VolumeMonitorMountAddedCallback
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 -> VolumeMonitorMountAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorMountAddedCallback
VolumeMonitorMountAddedCallback
cb
    let wrapped' :: C_VolumeMonitorMountAddedCallback
wrapped' = (a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorMountAddedCallback)
-> C_VolumeMonitorMountAddedCallback
wrap_VolumeMonitorMountRemovedCallback a -> VolumeMonitorMountAddedCallback
wrapped
    FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' <- C_VolumeMonitorMountAddedCallback
-> IO (FunPtr C_VolumeMonitorMountAddedCallback)
mk_VolumeMonitorMountRemovedCallback C_VolumeMonitorMountAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorMountAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"mount-removed" FunPtr C_VolumeMonitorMountAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorMountRemovedSignalInfo
instance SignalInfo VolumeMonitorMountRemovedSignalInfo where
    type HaskellCallbackType VolumeMonitorMountRemovedSignalInfo = VolumeMonitorMountRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorMountRemovedCallback cb
        cb'' <- mk_VolumeMonitorMountRemovedCallback cb'
        connectSignalFunPtr obj "mount-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::mount-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:mountRemoved"})

#endif

-- signal VolumeMonitor::volume-added
-- | Emitted when a mountable volume is added to the system.
type VolumeMonitorVolumeAddedCallback =
    Gio.Volume.Volume
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume' that was added.
    -> IO ()

type C_VolumeMonitorVolumeAddedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Volume.Volume ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorVolumeAddedCallback :: 
    GObject a => (a -> VolumeMonitorVolumeAddedCallback) ->
    C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeAddedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeAddedCallback a -> VolumeMonitorVolumeAddedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Volume
volume Ptr ()
_ = do
    Volume
volume' <- ((ManagedPtr Volume -> Volume) -> Ptr Volume -> IO Volume
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Volume -> Volume
Gio.Volume.Volume) Ptr Volume
volume
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorVolumeAddedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Volume
volume'


-- | Connect a signal handler for the [volumeAdded](#signal:volumeAdded) 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' volumeMonitor #volumeAdded callback
-- @
-- 
-- 
onVolumeMonitorVolumeAdded :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorVolumeAddedCallback) -> m SignalHandlerId
onVolumeMonitorVolumeAdded :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorVolumeAddedCallback)
-> m SignalHandlerId
onVolumeMonitorVolumeAdded a
obj (?self::a) => VolumeMonitorVolumeAddedCallback
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 -> VolumeMonitorVolumeAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorVolumeAddedCallback
VolumeMonitorVolumeAddedCallback
cb
    let wrapped' :: C_VolumeMonitorVolumeAddedCallback
wrapped' = (a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeAddedCallback a -> VolumeMonitorVolumeAddedCallback
wrapped
    FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' <- C_VolumeMonitorVolumeAddedCallback
-> IO (FunPtr C_VolumeMonitorVolumeAddedCallback)
mk_VolumeMonitorVolumeAddedCallback C_VolumeMonitorVolumeAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorVolumeAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"volume-added" FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [volumeAdded](#signal:volumeAdded) 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' volumeMonitor #volumeAdded 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.
-- 
afterVolumeMonitorVolumeAdded :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorVolumeAddedCallback) -> m SignalHandlerId
afterVolumeMonitorVolumeAdded :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorVolumeAddedCallback)
-> m SignalHandlerId
afterVolumeMonitorVolumeAdded a
obj (?self::a) => VolumeMonitorVolumeAddedCallback
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 -> VolumeMonitorVolumeAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorVolumeAddedCallback
VolumeMonitorVolumeAddedCallback
cb
    let wrapped' :: C_VolumeMonitorVolumeAddedCallback
wrapped' = (a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeAddedCallback a -> VolumeMonitorVolumeAddedCallback
wrapped
    FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' <- C_VolumeMonitorVolumeAddedCallback
-> IO (FunPtr C_VolumeMonitorVolumeAddedCallback)
mk_VolumeMonitorVolumeAddedCallback C_VolumeMonitorVolumeAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorVolumeAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"volume-added" FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorVolumeAddedSignalInfo
instance SignalInfo VolumeMonitorVolumeAddedSignalInfo where
    type HaskellCallbackType VolumeMonitorVolumeAddedSignalInfo = VolumeMonitorVolumeAddedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorVolumeAddedCallback cb
        cb'' <- mk_VolumeMonitorVolumeAddedCallback cb'
        connectSignalFunPtr obj "volume-added" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::volume-added"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:volumeAdded"})

#endif

-- signal VolumeMonitor::volume-changed
-- | Emitted when mountable volume is changed.
type VolumeMonitorVolumeChangedCallback =
    Gio.Volume.Volume
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume' that changed.
    -> IO ()

type C_VolumeMonitorVolumeChangedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Volume.Volume ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorVolumeChangedCallback :: 
    GObject a => (a -> VolumeMonitorVolumeChangedCallback) ->
    C_VolumeMonitorVolumeChangedCallback
wrap_VolumeMonitorVolumeChangedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeChangedCallback a -> VolumeMonitorVolumeAddedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Volume
volume Ptr ()
_ = do
    Volume
volume' <- ((ManagedPtr Volume -> Volume) -> Ptr Volume -> IO Volume
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Volume -> Volume
Gio.Volume.Volume) Ptr Volume
volume
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorVolumeAddedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Volume
volume'


-- | Connect a signal handler for the [volumeChanged](#signal:volumeChanged) 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' volumeMonitor #volumeChanged callback
-- @
-- 
-- 
onVolumeMonitorVolumeChanged :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorVolumeChangedCallback) -> m SignalHandlerId
onVolumeMonitorVolumeChanged :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorVolumeAddedCallback)
-> m SignalHandlerId
onVolumeMonitorVolumeChanged a
obj (?self::a) => VolumeMonitorVolumeAddedCallback
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 -> VolumeMonitorVolumeAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorVolumeAddedCallback
VolumeMonitorVolumeAddedCallback
cb
    let wrapped' :: C_VolumeMonitorVolumeAddedCallback
wrapped' = (a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeChangedCallback a -> VolumeMonitorVolumeAddedCallback
wrapped
    FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' <- C_VolumeMonitorVolumeAddedCallback
-> IO (FunPtr C_VolumeMonitorVolumeAddedCallback)
mk_VolumeMonitorVolumeChangedCallback C_VolumeMonitorVolumeAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorVolumeAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"volume-changed" FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [volumeChanged](#signal:volumeChanged) 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' volumeMonitor #volumeChanged 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.
-- 
afterVolumeMonitorVolumeChanged :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorVolumeChangedCallback) -> m SignalHandlerId
afterVolumeMonitorVolumeChanged :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorVolumeAddedCallback)
-> m SignalHandlerId
afterVolumeMonitorVolumeChanged a
obj (?self::a) => VolumeMonitorVolumeAddedCallback
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 -> VolumeMonitorVolumeAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorVolumeAddedCallback
VolumeMonitorVolumeAddedCallback
cb
    let wrapped' :: C_VolumeMonitorVolumeAddedCallback
wrapped' = (a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeChangedCallback a -> VolumeMonitorVolumeAddedCallback
wrapped
    FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' <- C_VolumeMonitorVolumeAddedCallback
-> IO (FunPtr C_VolumeMonitorVolumeAddedCallback)
mk_VolumeMonitorVolumeChangedCallback C_VolumeMonitorVolumeAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorVolumeAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"volume-changed" FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorVolumeChangedSignalInfo
instance SignalInfo VolumeMonitorVolumeChangedSignalInfo where
    type HaskellCallbackType VolumeMonitorVolumeChangedSignalInfo = VolumeMonitorVolumeChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorVolumeChangedCallback cb
        cb'' <- mk_VolumeMonitorVolumeChangedCallback cb'
        connectSignalFunPtr obj "volume-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::volume-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:volumeChanged"})

#endif

-- signal VolumeMonitor::volume-removed
-- | Emitted when a mountable volume is removed from the system.
type VolumeMonitorVolumeRemovedCallback =
    Gio.Volume.Volume
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume' that was removed.
    -> IO ()

type C_VolumeMonitorVolumeRemovedCallback =
    Ptr VolumeMonitor ->                    -- object
    Ptr Gio.Volume.Volume ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VolumeMonitorVolumeRemovedCallback :: 
    GObject a => (a -> VolumeMonitorVolumeRemovedCallback) ->
    C_VolumeMonitorVolumeRemovedCallback
wrap_VolumeMonitorVolumeRemovedCallback :: forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeRemovedCallback a -> VolumeMonitorVolumeAddedCallback
gi'cb Ptr VolumeMonitor
gi'selfPtr Ptr Volume
volume Ptr ()
_ = do
    Volume
volume' <- ((ManagedPtr Volume -> Volume) -> Ptr Volume -> IO Volume
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Volume -> Volume
Gio.Volume.Volume) Ptr Volume
volume
    Ptr VolumeMonitor -> (VolumeMonitor -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr VolumeMonitor
gi'selfPtr ((VolumeMonitor -> IO ()) -> IO ())
-> (VolumeMonitor -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VolumeMonitor
gi'self -> a -> VolumeMonitorVolumeAddedCallback
gi'cb (VolumeMonitor -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VolumeMonitor
gi'self)  Volume
volume'


-- | Connect a signal handler for the [volumeRemoved](#signal:volumeRemoved) 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' volumeMonitor #volumeRemoved callback
-- @
-- 
-- 
onVolumeMonitorVolumeRemoved :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorVolumeRemovedCallback) -> m SignalHandlerId
onVolumeMonitorVolumeRemoved :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorVolumeAddedCallback)
-> m SignalHandlerId
onVolumeMonitorVolumeRemoved a
obj (?self::a) => VolumeMonitorVolumeAddedCallback
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 -> VolumeMonitorVolumeAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorVolumeAddedCallback
VolumeMonitorVolumeAddedCallback
cb
    let wrapped' :: C_VolumeMonitorVolumeAddedCallback
wrapped' = (a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeRemovedCallback a -> VolumeMonitorVolumeAddedCallback
wrapped
    FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' <- C_VolumeMonitorVolumeAddedCallback
-> IO (FunPtr C_VolumeMonitorVolumeAddedCallback)
mk_VolumeMonitorVolumeRemovedCallback C_VolumeMonitorVolumeAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorVolumeAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"volume-removed" FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [volumeRemoved](#signal:volumeRemoved) 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' volumeMonitor #volumeRemoved 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.
-- 
afterVolumeMonitorVolumeRemoved :: (IsVolumeMonitor a, MonadIO m) => a -> ((?self :: a) => VolumeMonitorVolumeRemovedCallback) -> m SignalHandlerId
afterVolumeMonitorVolumeRemoved :: forall a (m :: * -> *).
(IsVolumeMonitor a, MonadIO m) =>
a
-> ((?self::a) => VolumeMonitorVolumeAddedCallback)
-> m SignalHandlerId
afterVolumeMonitorVolumeRemoved a
obj (?self::a) => VolumeMonitorVolumeAddedCallback
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 -> VolumeMonitorVolumeAddedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VolumeMonitorVolumeAddedCallback
VolumeMonitorVolumeAddedCallback
cb
    let wrapped' :: C_VolumeMonitorVolumeAddedCallback
wrapped' = (a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
forall a.
GObject a =>
(a -> VolumeMonitorVolumeAddedCallback)
-> C_VolumeMonitorVolumeAddedCallback
wrap_VolumeMonitorVolumeRemovedCallback a -> VolumeMonitorVolumeAddedCallback
wrapped
    FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' <- C_VolumeMonitorVolumeAddedCallback
-> IO (FunPtr C_VolumeMonitorVolumeAddedCallback)
mk_VolumeMonitorVolumeRemovedCallback C_VolumeMonitorVolumeAddedCallback
wrapped'
    a
-> Text
-> FunPtr C_VolumeMonitorVolumeAddedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"volume-removed" FunPtr C_VolumeMonitorVolumeAddedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeMonitorVolumeRemovedSignalInfo
instance SignalInfo VolumeMonitorVolumeRemovedSignalInfo where
    type HaskellCallbackType VolumeMonitorVolumeRemovedSignalInfo = VolumeMonitorVolumeRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeMonitorVolumeRemovedCallback cb
        cb'' <- mk_VolumeMonitorVolumeRemovedCallback cb'
        connectSignalFunPtr obj "volume-removed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.VolumeMonitor::volume-removed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-VolumeMonitor.html#g:signal:volumeRemoved"})

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList VolumeMonitor = VolumeMonitorSignalList
type VolumeMonitorSignalList = ('[ '("driveChanged", VolumeMonitorDriveChangedSignalInfo), '("driveConnected", VolumeMonitorDriveConnectedSignalInfo), '("driveDisconnected", VolumeMonitorDriveDisconnectedSignalInfo), '("driveEjectButton", VolumeMonitorDriveEjectButtonSignalInfo), '("driveStopButton", VolumeMonitorDriveStopButtonSignalInfo), '("mountAdded", VolumeMonitorMountAddedSignalInfo), '("mountChanged", VolumeMonitorMountChangedSignalInfo), '("mountPreUnmount", VolumeMonitorMountPreUnmountSignalInfo), '("mountRemoved", VolumeMonitorMountRemovedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("volumeAdded", VolumeMonitorVolumeAddedSignalInfo), '("volumeChanged", VolumeMonitorVolumeChangedSignalInfo), '("volumeRemoved", VolumeMonitorVolumeRemovedSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "g_volume_monitor_get_connected_drives" g_volume_monitor_get_connected_drives :: 
    Ptr VolumeMonitor ->                    -- volume_monitor : TInterface (Name {namespace = "Gio", name = "VolumeMonitor"})
    IO (Ptr (GList (Ptr Gio.Drive.Drive)))

-- | Gets a list of drives connected to the system.
-- 
-- The returned list should be freed with @/g_list_free()/@, after
-- its elements have been unreffed with 'GI.GObject.Objects.Object.objectUnref'.
volumeMonitorGetConnectedDrives ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolumeMonitor a) =>
    a
    -- ^ /@volumeMonitor@/: a t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'.
    -> m [Gio.Drive.Drive]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of connected t'GI.Gio.Interfaces.Drive.Drive' objects.
volumeMonitorGetConnectedDrives :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolumeMonitor a) =>
a -> m [Drive]
volumeMonitorGetConnectedDrives a
volumeMonitor = IO [Drive] -> m [Drive]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Drive] -> m [Drive]) -> IO [Drive] -> m [Drive]
forall a b. (a -> b) -> a -> b
$ do
    Ptr VolumeMonitor
volumeMonitor' <- a -> IO (Ptr VolumeMonitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volumeMonitor
    Ptr (GList (Ptr Drive))
result <- Ptr VolumeMonitor -> IO (Ptr (GList (Ptr Drive)))
g_volume_monitor_get_connected_drives Ptr VolumeMonitor
volumeMonitor'
    [Ptr Drive]
result' <- Ptr (GList (Ptr Drive)) -> IO [Ptr Drive]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Drive))
result
    [Drive]
result'' <- (Ptr Drive -> IO Drive) -> [Ptr Drive] -> IO [Drive]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Drive -> Drive) -> Ptr Drive -> IO Drive
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Drive -> Drive
Gio.Drive.Drive) [Ptr Drive]
result'
    Ptr (GList (Ptr Drive)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Drive))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volumeMonitor
    [Drive] -> IO [Drive]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Drive]
result''

#if defined(ENABLE_OVERLOADING)
data VolumeMonitorGetConnectedDrivesMethodInfo
instance (signature ~ (m [Gio.Drive.Drive]), MonadIO m, IsVolumeMonitor a) => O.OverloadedMethod VolumeMonitorGetConnectedDrivesMethodInfo a signature where
    overloadedMethod = volumeMonitorGetConnectedDrives

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


#endif

-- method VolumeMonitor::get_mount_for_uuid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume_monitor"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "VolumeMonitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVolumeMonitor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uuid"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the UUID to look for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Mount" })
-- throws : False
-- Skip return : False

foreign import ccall "g_volume_monitor_get_mount_for_uuid" g_volume_monitor_get_mount_for_uuid :: 
    Ptr VolumeMonitor ->                    -- volume_monitor : TInterface (Name {namespace = "Gio", name = "VolumeMonitor"})
    CString ->                              -- uuid : TBasicType TUTF8
    IO (Ptr Gio.Mount.Mount)

-- | Finds a t'GI.Gio.Interfaces.Mount.Mount' object by its UUID (see 'GI.Gio.Interfaces.Mount.mountGetUuid')
volumeMonitorGetMountForUuid ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolumeMonitor a) =>
    a
    -- ^ /@volumeMonitor@/: a t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'.
    -> T.Text
    -- ^ /@uuid@/: the UUID to look for
    -> m (Maybe Gio.Mount.Mount)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Mount.Mount' or 'P.Nothing' if no such mount is available.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'.
volumeMonitorGetMountForUuid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolumeMonitor a) =>
a -> Text -> m (Maybe Mount)
volumeMonitorGetMountForUuid a
volumeMonitor Text
uuid = IO (Maybe Mount) -> m (Maybe Mount)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Mount) -> m (Maybe Mount))
-> IO (Maybe Mount) -> m (Maybe Mount)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VolumeMonitor
volumeMonitor' <- a -> IO (Ptr VolumeMonitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volumeMonitor
    CString
uuid' <- Text -> IO CString
textToCString Text
uuid
    Ptr Mount
result <- Ptr VolumeMonitor -> CString -> IO (Ptr Mount)
g_volume_monitor_get_mount_for_uuid Ptr VolumeMonitor
volumeMonitor' CString
uuid'
    Maybe Mount
maybeResult <- Ptr Mount -> (Ptr Mount -> IO Mount) -> IO (Maybe Mount)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Mount
result ((Ptr Mount -> IO Mount) -> IO (Maybe Mount))
-> (Ptr Mount -> IO Mount) -> IO (Maybe Mount)
forall a b. (a -> b) -> a -> b
$ \Ptr Mount
result' -> do
        Mount
result'' <- ((ManagedPtr Mount -> Mount) -> Ptr Mount -> IO Mount
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Mount -> Mount
Gio.Mount.Mount) Ptr Mount
result'
        Mount -> IO Mount
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Mount
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volumeMonitor
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uuid'
    Maybe Mount -> IO (Maybe Mount)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mount
maybeResult

#if defined(ENABLE_OVERLOADING)
data VolumeMonitorGetMountForUuidMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gio.Mount.Mount)), MonadIO m, IsVolumeMonitor a) => O.OverloadedMethod VolumeMonitorGetMountForUuidMethodInfo a signature where
    overloadedMethod = volumeMonitorGetMountForUuid

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


#endif

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

foreign import ccall "g_volume_monitor_get_mounts" g_volume_monitor_get_mounts :: 
    Ptr VolumeMonitor ->                    -- volume_monitor : TInterface (Name {namespace = "Gio", name = "VolumeMonitor"})
    IO (Ptr (GList (Ptr Gio.Mount.Mount)))

-- | Gets a list of the mounts on the system.
-- 
-- The returned list should be freed with @/g_list_free()/@, after
-- its elements have been unreffed with 'GI.GObject.Objects.Object.objectUnref'.
volumeMonitorGetMounts ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolumeMonitor a) =>
    a
    -- ^ /@volumeMonitor@/: a t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'.
    -> m [Gio.Mount.Mount]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of t'GI.Gio.Interfaces.Mount.Mount' objects.
volumeMonitorGetMounts :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolumeMonitor a) =>
a -> m [Mount]
volumeMonitorGetMounts a
volumeMonitor = IO [Mount] -> m [Mount]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Mount] -> m [Mount]) -> IO [Mount] -> m [Mount]
forall a b. (a -> b) -> a -> b
$ do
    Ptr VolumeMonitor
volumeMonitor' <- a -> IO (Ptr VolumeMonitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volumeMonitor
    Ptr (GList (Ptr Mount))
result <- Ptr VolumeMonitor -> IO (Ptr (GList (Ptr Mount)))
g_volume_monitor_get_mounts Ptr VolumeMonitor
volumeMonitor'
    [Ptr Mount]
result' <- Ptr (GList (Ptr Mount)) -> IO [Ptr Mount]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Mount))
result
    [Mount]
result'' <- (Ptr Mount -> IO Mount) -> [Ptr Mount] -> IO [Mount]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Mount -> Mount) -> Ptr Mount -> IO Mount
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Mount -> Mount
Gio.Mount.Mount) [Ptr Mount]
result'
    Ptr (GList (Ptr Mount)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Mount))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volumeMonitor
    [Mount] -> IO [Mount]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Mount]
result''

#if defined(ENABLE_OVERLOADING)
data VolumeMonitorGetMountsMethodInfo
instance (signature ~ (m [Gio.Mount.Mount]), MonadIO m, IsVolumeMonitor a) => O.OverloadedMethod VolumeMonitorGetMountsMethodInfo a signature where
    overloadedMethod = volumeMonitorGetMounts

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


#endif

-- method VolumeMonitor::get_volume_for_uuid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume_monitor"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "VolumeMonitor" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVolumeMonitor." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uuid"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the UUID to look for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Volume" })
-- throws : False
-- Skip return : False

foreign import ccall "g_volume_monitor_get_volume_for_uuid" g_volume_monitor_get_volume_for_uuid :: 
    Ptr VolumeMonitor ->                    -- volume_monitor : TInterface (Name {namespace = "Gio", name = "VolumeMonitor"})
    CString ->                              -- uuid : TBasicType TUTF8
    IO (Ptr Gio.Volume.Volume)

-- | Finds a t'GI.Gio.Interfaces.Volume.Volume' object by its UUID (see 'GI.Gio.Interfaces.Volume.volumeGetUuid')
volumeMonitorGetVolumeForUuid ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolumeMonitor a) =>
    a
    -- ^ /@volumeMonitor@/: a t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'.
    -> T.Text
    -- ^ /@uuid@/: the UUID to look for
    -> m (Maybe Gio.Volume.Volume)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Volume.Volume' or 'P.Nothing' if no such volume is available.
    --     Free the returned object with 'GI.GObject.Objects.Object.objectUnref'.
volumeMonitorGetVolumeForUuid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolumeMonitor a) =>
a -> Text -> m (Maybe Volume)
volumeMonitorGetVolumeForUuid a
volumeMonitor Text
uuid = IO (Maybe Volume) -> m (Maybe Volume)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Volume) -> m (Maybe Volume))
-> IO (Maybe Volume) -> m (Maybe Volume)
forall a b. (a -> b) -> a -> b
$ do
    Ptr VolumeMonitor
volumeMonitor' <- a -> IO (Ptr VolumeMonitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volumeMonitor
    CString
uuid' <- Text -> IO CString
textToCString Text
uuid
    Ptr Volume
result <- Ptr VolumeMonitor -> CString -> IO (Ptr Volume)
g_volume_monitor_get_volume_for_uuid Ptr VolumeMonitor
volumeMonitor' CString
uuid'
    Maybe Volume
maybeResult <- Ptr Volume -> (Ptr Volume -> IO Volume) -> IO (Maybe Volume)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Volume
result ((Ptr Volume -> IO Volume) -> IO (Maybe Volume))
-> (Ptr Volume -> IO Volume) -> IO (Maybe Volume)
forall a b. (a -> b) -> a -> b
$ \Ptr Volume
result' -> do
        Volume
result'' <- ((ManagedPtr Volume -> Volume) -> Ptr Volume -> IO Volume
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Volume -> Volume
Gio.Volume.Volume) Ptr Volume
result'
        Volume -> IO Volume
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Volume
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volumeMonitor
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
uuid'
    Maybe Volume -> IO (Maybe Volume)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Volume
maybeResult

#if defined(ENABLE_OVERLOADING)
data VolumeMonitorGetVolumeForUuidMethodInfo
instance (signature ~ (T.Text -> m (Maybe Gio.Volume.Volume)), MonadIO m, IsVolumeMonitor a) => O.OverloadedMethod VolumeMonitorGetVolumeForUuidMethodInfo a signature where
    overloadedMethod = volumeMonitorGetVolumeForUuid

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


#endif

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

foreign import ccall "g_volume_monitor_get_volumes" g_volume_monitor_get_volumes :: 
    Ptr VolumeMonitor ->                    -- volume_monitor : TInterface (Name {namespace = "Gio", name = "VolumeMonitor"})
    IO (Ptr (GList (Ptr Gio.Volume.Volume)))

-- | Gets a list of the volumes on the system.
-- 
-- The returned list should be freed with @/g_list_free()/@, after
-- its elements have been unreffed with 'GI.GObject.Objects.Object.objectUnref'.
volumeMonitorGetVolumes ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolumeMonitor a) =>
    a
    -- ^ /@volumeMonitor@/: a t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'.
    -> m [Gio.Volume.Volume]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of t'GI.Gio.Interfaces.Volume.Volume' objects.
volumeMonitorGetVolumes :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolumeMonitor a) =>
a -> m [Volume]
volumeMonitorGetVolumes a
volumeMonitor = IO [Volume] -> m [Volume]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Volume] -> m [Volume]) -> IO [Volume] -> m [Volume]
forall a b. (a -> b) -> a -> b
$ do
    Ptr VolumeMonitor
volumeMonitor' <- a -> IO (Ptr VolumeMonitor)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volumeMonitor
    Ptr (GList (Ptr Volume))
result <- Ptr VolumeMonitor -> IO (Ptr (GList (Ptr Volume)))
g_volume_monitor_get_volumes Ptr VolumeMonitor
volumeMonitor'
    [Ptr Volume]
result' <- Ptr (GList (Ptr Volume)) -> IO [Ptr Volume]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr Volume))
result
    [Volume]
result'' <- (Ptr Volume -> IO Volume) -> [Ptr Volume] -> IO [Volume]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((ManagedPtr Volume -> Volume) -> Ptr Volume -> IO Volume
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Volume -> Volume
Gio.Volume.Volume) [Ptr Volume]
result'
    Ptr (GList (Ptr Volume)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr Volume))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volumeMonitor
    [Volume] -> IO [Volume]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Volume]
result''

#if defined(ENABLE_OVERLOADING)
data VolumeMonitorGetVolumesMethodInfo
instance (signature ~ (m [Gio.Volume.Volume]), MonadIO m, IsVolumeMonitor a) => O.OverloadedMethod VolumeMonitorGetVolumesMethodInfo a signature where
    overloadedMethod = volumeMonitorGetVolumes

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


#endif

-- method VolumeMonitor::adopt_orphan_mount
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount object to find a parent for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Volume" })
-- throws : False
-- Skip return : False

foreign import ccall "g_volume_monitor_adopt_orphan_mount" g_volume_monitor_adopt_orphan_mount :: 
    Ptr Gio.Mount.Mount ->                  -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO (Ptr Gio.Volume.Volume)

{-# DEPRECATED volumeMonitorAdoptOrphanMount ["(Since version 2.20)","Instead of using this function, t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'","implementations should instead create shadow mounts with the URI of","the mount they intend to adopt. See the proxy volume monitor in","gvfs for an example of this. Also see 'GI.Gio.Interfaces.Mount.mountIsShadowed',","'GI.Gio.Interfaces.Mount.mountShadow' and 'GI.Gio.Interfaces.Mount.mountUnshadow' functions."] #-}
-- | This function should be called by any t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'
-- implementation when a new t'GI.Gio.Interfaces.Mount.Mount' object is created that is not
-- associated with a t'GI.Gio.Interfaces.Volume.Volume' object. It must be called just before
-- emitting the /@mountAdded@/ signal.
-- 
-- If the return value is not 'P.Nothing', the caller must associate the
-- returned t'GI.Gio.Interfaces.Volume.Volume' object with the t'GI.Gio.Interfaces.Mount.Mount'. This involves returning
-- it in its 'GI.Gio.Interfaces.Mount.mountGetVolume' implementation. The caller must
-- also listen for the \"removed\" signal on the returned object
-- and give up its reference when handling that signal
-- 
-- Similarly, if implementing 'GI.Gio.Objects.VolumeMonitor.volumeMonitorAdoptOrphanMount',
-- the implementor must take a reference to /@mount@/ and return it in
-- its 'GI.Gio.Interfaces.Volume.volumeGetMount' implemented. Also, the implementor must
-- listen for the \"unmounted\" signal on /@mount@/ and give up its
-- reference upon handling that signal.
-- 
-- There are two main use cases for this function.
-- 
-- One is when implementing a user space file system driver that reads
-- blocks of a block device that is already represented by the native
-- volume monitor (for example a CD Audio file system driver). Such
-- a driver will generate its own t'GI.Gio.Interfaces.Mount.Mount' object that needs to be
-- associated with the t'GI.Gio.Interfaces.Volume.Volume' object that represents the volume.
-- 
-- The other is for implementing a t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor' whose sole purpose
-- is to return t'GI.Gio.Interfaces.Volume.Volume' objects representing entries in the users
-- \"favorite servers\" list or similar.
volumeMonitorAdoptOrphanMount ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Mount.IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount' object to find a parent for
    -> m Gio.Volume.Volume
    -- ^ __Returns:__ the t'GI.Gio.Interfaces.Volume.Volume' object that is the parent for /@mount@/ or 'P.Nothing'
    -- if no wants to adopt the t'GI.Gio.Interfaces.Mount.Mount'.
volumeMonitorAdoptOrphanMount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m Volume
volumeMonitorAdoptOrphanMount a
mount = IO Volume -> m Volume
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Volume -> m Volume) -> IO Volume -> m Volume
forall a b. (a -> b) -> a -> b
$ do
    Ptr Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr Volume
result <- Ptr Mount -> IO (Ptr Volume)
g_volume_monitor_adopt_orphan_mount Ptr Mount
mount'
    Text -> Ptr Volume -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"volumeMonitorAdoptOrphanMount" Ptr Volume
result
    Volume
result' <- ((ManagedPtr Volume -> Volume) -> Ptr Volume -> IO Volume
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Volume -> Volume
Gio.Volume.Volume) Ptr Volume
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
    Volume -> IO Volume
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Volume
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "g_volume_monitor_get" g_volume_monitor_get :: 
    IO (Ptr VolumeMonitor)

-- | Gets the volume monitor used by gio.
volumeMonitorGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m VolumeMonitor
    -- ^ __Returns:__ a reference to the t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor' used by gio. Call
    --    'GI.GObject.Objects.Object.objectUnref' when done with it.
volumeMonitorGet :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m VolumeMonitor
volumeMonitorGet  = IO VolumeMonitor -> m VolumeMonitor
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VolumeMonitor -> m VolumeMonitor)
-> IO VolumeMonitor -> m VolumeMonitor
forall a b. (a -> b) -> a -> b
$ do
    Ptr VolumeMonitor
result <- IO (Ptr VolumeMonitor)
g_volume_monitor_get
    Text -> Ptr VolumeMonitor -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"volumeMonitorGet" Ptr VolumeMonitor
result
    VolumeMonitor
result' <- ((ManagedPtr VolumeMonitor -> VolumeMonitor)
-> Ptr VolumeMonitor -> IO VolumeMonitor
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VolumeMonitor -> VolumeMonitor
VolumeMonitor) Ptr VolumeMonitor
result
    VolumeMonitor -> IO VolumeMonitor
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VolumeMonitor
result'

#if defined(ENABLE_OVERLOADING)
#endif