{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gio.Interfaces.Volume.Volume' interface represents user-visible objects that can be
-- mounted. Note, when porting from GnomeVFS, t'GI.Gio.Interfaces.Volume.Volume' is the moral
-- equivalent of @/GnomeVFSDrive/@.
-- 
-- Mounting a t'GI.Gio.Interfaces.Volume.Volume' instance is an asynchronous operation. For more
-- information about asynchronous operations, see t'GI.Gio.Interfaces.AsyncResult.AsyncResult' and
-- t'GI.Gio.Objects.Task.Task'. To mount a t'GI.Gio.Interfaces.Volume.Volume', first call 'GI.Gio.Interfaces.Volume.volumeMount' with (at
-- least) the t'GI.Gio.Interfaces.Volume.Volume' instance, optionally a t'GI.Gio.Objects.MountOperation.MountOperation' object
-- and a t'GI.Gio.Callbacks.AsyncReadyCallback'.
-- 
-- Typically, one will only want to pass 'P.Nothing' for the
-- t'GI.Gio.Objects.MountOperation.MountOperation' if automounting all volumes when a desktop session
-- starts since it\'s not desirable to put up a lot of dialogs asking
-- for credentials.
-- 
-- The callback will be fired when the operation has resolved (either
-- with success or failure), and a t'GI.Gio.Interfaces.AsyncResult.AsyncResult' instance will be
-- passed to the callback.  That callback should then call
-- 'GI.Gio.Interfaces.Volume.volumeMountFinish' with the t'GI.Gio.Interfaces.Volume.Volume' instance and the
-- t'GI.Gio.Interfaces.AsyncResult.AsyncResult' data to see if the operation was completed
-- successfully.  If an /@error@/ is present when 'GI.Gio.Interfaces.Volume.volumeMountFinish'
-- is called, then it will be filled with any error information.
-- 
-- ## Volume Identifiers # {@/volume/@-identifier}
-- 
-- It is sometimes necessary to directly access the underlying
-- operating system object behind a volume (e.g. for passing a volume
-- to an application via the commandline). For this purpose, GIO
-- allows to obtain an \'identifier\' for the volume. There can be
-- different kinds of identifiers, such as Hal UDIs, filesystem labels,
-- traditional Unix devices (e.g. @\/dev\/sda2@), UUIDs. GIO uses predefined
-- strings as names for the different kinds of identifiers:
-- 'GI.Gio.Constants.VOLUME_IDENTIFIER_KIND_UUID', 'GI.Gio.Constants.VOLUME_IDENTIFIER_KIND_LABEL', etc.
-- Use 'GI.Gio.Interfaces.Volume.volumeGetIdentifier' to obtain an identifier for a volume.
-- 
-- 
-- Note that 'GI.Gio.Constants.VOLUME_IDENTIFIER_KIND_HAL_UDI' will only be available
-- when the gvfs hal volume monitor is in use. Other volume monitors
-- will generally be able to provide the 'GI.Gio.Constants.VOLUME_IDENTIFIER_KIND_UNIX_DEVICE'
-- identifier, which can be used to obtain a hal device by means of
-- @/libhal_manager_find_device_string_match()/@.

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

module GI.Gio.Interfaces.Volume
    ( 

-- * Exported types
    Volume(..)                              ,
    IsVolume                                ,
    toVolume                                ,


 -- * 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"), [canEject]("GI.Gio.Interfaces.Volume#g:method:canEject"), [canMount]("GI.Gio.Interfaces.Volume#g:method:canMount"), [eject]("GI.Gio.Interfaces.Volume#g:method:eject"), [ejectFinish]("GI.Gio.Interfaces.Volume#g:method:ejectFinish"), [ejectWithOperation]("GI.Gio.Interfaces.Volume#g:method:ejectWithOperation"), [ejectWithOperationFinish]("GI.Gio.Interfaces.Volume#g:method:ejectWithOperationFinish"), [enumerateIdentifiers]("GI.Gio.Interfaces.Volume#g:method:enumerateIdentifiers"), [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"), [mount]("GI.Gio.Interfaces.Volume#g:method:mount"), [mountFinish]("GI.Gio.Interfaces.Volume#g:method:mountFinish"), [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"), [shouldAutomount]("GI.Gio.Interfaces.Volume#g:method:shouldAutomount"), [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
-- [getActivationRoot]("GI.Gio.Interfaces.Volume#g:method:getActivationRoot"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDrive]("GI.Gio.Interfaces.Volume#g:method:getDrive"), [getIcon]("GI.Gio.Interfaces.Volume#g:method:getIcon"), [getIdentifier]("GI.Gio.Interfaces.Volume#g:method:getIdentifier"), [getMount]("GI.Gio.Interfaces.Volume#g:method:getMount"), [getName]("GI.Gio.Interfaces.Volume#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSortKey]("GI.Gio.Interfaces.Volume#g:method:getSortKey"), [getSymbolicIcon]("GI.Gio.Interfaces.Volume#g:method:getSymbolicIcon"), [getUuid]("GI.Gio.Interfaces.Volume#g:method:getUuid").
-- 
-- ==== 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)
    ResolveVolumeMethod                     ,
#endif

-- ** canEject #method:canEject#

#if defined(ENABLE_OVERLOADING)
    VolumeCanEjectMethodInfo                ,
#endif
    volumeCanEject                          ,


-- ** canMount #method:canMount#

#if defined(ENABLE_OVERLOADING)
    VolumeCanMountMethodInfo                ,
#endif
    volumeCanMount                          ,


-- ** eject #method:eject#

#if defined(ENABLE_OVERLOADING)
    VolumeEjectMethodInfo                   ,
#endif
    volumeEject                             ,


-- ** ejectFinish #method:ejectFinish#

#if defined(ENABLE_OVERLOADING)
    VolumeEjectFinishMethodInfo             ,
#endif
    volumeEjectFinish                       ,


-- ** ejectWithOperation #method:ejectWithOperation#

#if defined(ENABLE_OVERLOADING)
    VolumeEjectWithOperationMethodInfo      ,
#endif
    volumeEjectWithOperation                ,


-- ** ejectWithOperationFinish #method:ejectWithOperationFinish#

#if defined(ENABLE_OVERLOADING)
    VolumeEjectWithOperationFinishMethodInfo,
#endif
    volumeEjectWithOperationFinish          ,


-- ** enumerateIdentifiers #method:enumerateIdentifiers#

#if defined(ENABLE_OVERLOADING)
    VolumeEnumerateIdentifiersMethodInfo    ,
#endif
    volumeEnumerateIdentifiers              ,


-- ** getActivationRoot #method:getActivationRoot#

#if defined(ENABLE_OVERLOADING)
    VolumeGetActivationRootMethodInfo       ,
#endif
    volumeGetActivationRoot                 ,


-- ** getDrive #method:getDrive#

#if defined(ENABLE_OVERLOADING)
    VolumeGetDriveMethodInfo                ,
#endif
    volumeGetDrive                          ,


-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    VolumeGetIconMethodInfo                 ,
#endif
    volumeGetIcon                           ,


-- ** getIdentifier #method:getIdentifier#

#if defined(ENABLE_OVERLOADING)
    VolumeGetIdentifierMethodInfo           ,
#endif
    volumeGetIdentifier                     ,


-- ** getMount #method:getMount#

#if defined(ENABLE_OVERLOADING)
    VolumeGetMountMethodInfo                ,
#endif
    volumeGetMount                          ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    VolumeGetNameMethodInfo                 ,
#endif
    volumeGetName                           ,


-- ** getSortKey #method:getSortKey#

#if defined(ENABLE_OVERLOADING)
    VolumeGetSortKeyMethodInfo              ,
#endif
    volumeGetSortKey                        ,


-- ** getSymbolicIcon #method:getSymbolicIcon#

#if defined(ENABLE_OVERLOADING)
    VolumeGetSymbolicIconMethodInfo         ,
#endif
    volumeGetSymbolicIcon                   ,


-- ** getUuid #method:getUuid#

#if defined(ENABLE_OVERLOADING)
    VolumeGetUuidMethodInfo                 ,
#endif
    volumeGetUuid                           ,


-- ** mount #method:mount#

#if defined(ENABLE_OVERLOADING)
    VolumeMountMethodInfo                   ,
#endif
    volumeMount                             ,


-- ** mountFinish #method:mountFinish#

#if defined(ENABLE_OVERLOADING)
    VolumeMountFinishMethodInfo             ,
#endif
    volumeMountFinish                       ,


-- ** shouldAutomount #method:shouldAutomount#

#if defined(ENABLE_OVERLOADING)
    VolumeShouldAutomountMethodInfo         ,
#endif
    volumeShouldAutomount                   ,




 -- * Signals


-- ** changed #signal:changed#

    C_VolumeChangedCallback                 ,
    VolumeChangedCallback                   ,
#if defined(ENABLE_OVERLOADING)
    VolumeChangedSignalInfo                 ,
#endif
    afterVolumeChanged                      ,
    genClosure_VolumeChanged                ,
    mk_VolumeChangedCallback                ,
    noVolumeChangedCallback                 ,
    onVolumeChanged                         ,
    wrap_VolumeChangedCallback              ,


-- ** removed #signal:removed#

    C_VolumeRemovedCallback                 ,
    VolumeRemovedCallback                   ,
#if defined(ENABLE_OVERLOADING)
    VolumeRemovedSignalInfo                 ,
#endif
    afterVolumeRemoved                      ,
    genClosure_VolumeRemoved                ,
    mk_VolumeRemovedCallback                ,
    noVolumeRemovedCallback                 ,
    onVolumeRemoved                         ,
    wrap_VolumeRemovedCallback              ,




    ) 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.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.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

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

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

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

foreign import ccall "g_volume_get_type"
    c_g_volume_get_type :: IO B.Types.GType

instance B.Types.TypedObject Volume where
    glibType :: IO GType
glibType = IO GType
c_g_volume_get_type

instance B.Types.GObject Volume

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveVolumeMethod (t :: Symbol) (o :: *) :: * where
    ResolveVolumeMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveVolumeMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveVolumeMethod "canEject" o = VolumeCanEjectMethodInfo
    ResolveVolumeMethod "canMount" o = VolumeCanMountMethodInfo
    ResolveVolumeMethod "eject" o = VolumeEjectMethodInfo
    ResolveVolumeMethod "ejectFinish" o = VolumeEjectFinishMethodInfo
    ResolveVolumeMethod "ejectWithOperation" o = VolumeEjectWithOperationMethodInfo
    ResolveVolumeMethod "ejectWithOperationFinish" o = VolumeEjectWithOperationFinishMethodInfo
    ResolveVolumeMethod "enumerateIdentifiers" o = VolumeEnumerateIdentifiersMethodInfo
    ResolveVolumeMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveVolumeMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveVolumeMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveVolumeMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveVolumeMethod "mount" o = VolumeMountMethodInfo
    ResolveVolumeMethod "mountFinish" o = VolumeMountFinishMethodInfo
    ResolveVolumeMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveVolumeMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveVolumeMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveVolumeMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveVolumeMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveVolumeMethod "shouldAutomount" o = VolumeShouldAutomountMethodInfo
    ResolveVolumeMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveVolumeMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveVolumeMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveVolumeMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveVolumeMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveVolumeMethod "getActivationRoot" o = VolumeGetActivationRootMethodInfo
    ResolveVolumeMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveVolumeMethod "getDrive" o = VolumeGetDriveMethodInfo
    ResolveVolumeMethod "getIcon" o = VolumeGetIconMethodInfo
    ResolveVolumeMethod "getIdentifier" o = VolumeGetIdentifierMethodInfo
    ResolveVolumeMethod "getMount" o = VolumeGetMountMethodInfo
    ResolveVolumeMethod "getName" o = VolumeGetNameMethodInfo
    ResolveVolumeMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveVolumeMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveVolumeMethod "getSortKey" o = VolumeGetSortKeyMethodInfo
    ResolveVolumeMethod "getSymbolicIcon" o = VolumeGetSymbolicIconMethodInfo
    ResolveVolumeMethod "getUuid" o = VolumeGetUuidMethodInfo
    ResolveVolumeMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveVolumeMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveVolumeMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveVolumeMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

foreign import ccall "g_volume_can_eject" g_volume_can_eject :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO CInt

-- | Checks if a volume can be ejected.
volumeCanEject ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@volume@/ can be ejected. 'P.False' otherwise
volumeCanEject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m Bool
volumeCanEject a
volume = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    CInt
result <- Ptr Volume -> IO CInt
g_volume_can_eject Ptr Volume
volume'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VolumeCanEjectMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeCanEjectMethodInfo a signature where
    overloadedMethod = volumeCanEject

instance O.OverloadedMethodInfo VolumeCanEjectMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeCanEject",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeCanEject"
        }


#endif

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

foreign import ccall "g_volume_can_mount" g_volume_can_mount :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO CInt

-- | Checks if a volume can be mounted.
volumeCanMount ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@volume@/ can be mounted. 'P.False' otherwise
volumeCanMount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m Bool
volumeCanMount a
volume = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    CInt
result <- Ptr Volume -> IO CInt
g_volume_can_mount Ptr Volume
volume'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VolumeCanMountMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeCanMountMethodInfo a signature where
    overloadedMethod = volumeCanMount

instance O.OverloadedMethodInfo VolumeCanMountMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeCanMount",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeCanMount"
        }


#endif

-- method Volume::eject
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType = TInterface Name { namespace = "Gio" , name = "Volume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVolume" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountUnmountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "flags affecting the unmount if required for eject"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncReadyCallback, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 4
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data that gets passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_volume_eject" g_volume_eject :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountUnmountFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

{-# DEPRECATED volumeEject ["(Since version 2.22)","Use 'GI.Gio.Interfaces.Volume.volumeEjectWithOperation' instead."] #-}
-- | Ejects a volume. This is an asynchronous operation, and is
-- finished by calling 'GI.Gio.Interfaces.Volume.volumeEjectFinish' with the /@volume@/
-- and t'GI.Gio.Interfaces.AsyncResult.AsyncResult' returned in the /@callback@/.
volumeEject ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@flags@/: flags affecting the unmount if required for eject
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback', or 'P.Nothing'
    -> m ()
volumeEject :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVolume a, IsCancellable b) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
volumeEject a
volume [MountUnmountFlags]
flags Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    let flags' :: CUInt
flags' = [MountUnmountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountUnmountFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Volume
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_volume_eject Ptr Volume
volume' CUInt
flags' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VolumeEjectMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsVolume a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod VolumeEjectMethodInfo a signature where
    overloadedMethod = volumeEject

instance O.OverloadedMethodInfo VolumeEjectMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeEject",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeEject"
        }


#endif

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

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

{-# DEPRECATED volumeEjectFinish ["(Since version 2.22)","Use 'GI.Gio.Interfaces.Volume.volumeEjectWithOperationFinish' instead."] #-}
-- | Finishes ejecting a volume. If any errors occurred during the operation,
-- /@error@/ will be set to contain the errors and 'P.False' will be returned.
volumeEjectFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@volume@/: pointer to a t'GI.Gio.Interfaces.Volume.Volume'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
volumeEjectFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVolume a, IsAsyncResult b) =>
a -> b -> m ()
volumeEjectFinish a
volume b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Volume -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_volume_eject_finish Ptr Volume
volume' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

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

instance O.OverloadedMethodInfo VolumeEjectFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeEjectFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeEjectFinish"
        }


#endif

-- method Volume::eject_with_operation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType = TInterface Name { namespace = "Gio" , name = "Volume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVolume" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountUnmountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "flags affecting the unmount if required for eject"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mount_operation"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountOperation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMountOperation or %NULL to\n    avoid user interaction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncReadyCallback, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_volume_eject_with_operation" g_volume_eject_with_operation :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountUnmountFlags"})
    Ptr Gio.MountOperation.MountOperation -> -- mount_operation : TInterface (Name {namespace = "Gio", name = "MountOperation"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Ejects a volume. This is an asynchronous operation, and is
-- finished by calling 'GI.Gio.Interfaces.Volume.volumeEjectWithOperationFinish' with the /@volume@/
-- and t'GI.Gio.Interfaces.AsyncResult.AsyncResult' data returned in the /@callback@/.
-- 
-- /Since: 2.22/
volumeEjectWithOperation ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@flags@/: flags affecting the unmount if required for eject
    -> Maybe (b)
    -- ^ /@mountOperation@/: a t'GI.Gio.Objects.MountOperation.MountOperation' or 'P.Nothing' to
    --     avoid user interaction
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback', or 'P.Nothing'
    -> m ()
volumeEjectWithOperation :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsVolume a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
volumeEjectWithOperation a
volume [MountUnmountFlags]
flags Maybe b
mountOperation Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    let flags' :: CUInt
flags' = [MountUnmountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountUnmountFlags]
flags
    Ptr MountOperation
maybeMountOperation <- case Maybe b
mountOperation of
        Maybe b
Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just b
jMountOperation -> do
            Ptr MountOperation
jMountOperation' <- b -> IO (Ptr MountOperation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMountOperation
            Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
jMountOperation'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Volume
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_volume_eject_with_operation Ptr Volume
volume' CUInt
flags' Ptr MountOperation
maybeMountOperation Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mountOperation b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VolumeEjectWithOperationMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsVolume a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod VolumeEjectWithOperationMethodInfo a signature where
    overloadedMethod = volumeEjectWithOperation

instance O.OverloadedMethodInfo VolumeEjectWithOperationMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeEjectWithOperation",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeEjectWithOperation"
        }


#endif

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

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

-- | Finishes ejecting a volume. If any errors occurred during the operation,
-- /@error@/ will be set to contain the errors and 'P.False' will be returned.
-- 
-- /Since: 2.22/
volumeEjectWithOperationFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
volumeEjectWithOperationFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVolume a, IsAsyncResult b) =>
a -> b -> m ()
volumeEjectWithOperationFinish a
volume b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Volume -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_volume_eject_with_operation_finish Ptr Volume
volume' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

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

instance O.OverloadedMethodInfo VolumeEjectWithOperationFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeEjectWithOperationFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeEjectWithOperationFinish"
        }


#endif

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

foreign import ccall "g_volume_enumerate_identifiers" g_volume_enumerate_identifiers :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO (Ptr CString)

-- | Gets the kinds of [identifiers][volume-identifier] that /@volume@/ has.
-- Use 'GI.Gio.Interfaces.Volume.volumeGetIdentifier' to obtain the identifiers themselves.
volumeEnumerateIdentifiers ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array
    --   of strings containing kinds of identifiers. Use 'GI.GLib.Functions.strfreev' to free.
volumeEnumerateIdentifiers :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m [Text]
volumeEnumerateIdentifiers a
volume = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr CString
result <- Ptr Volume -> IO (Ptr CString)
g_volume_enumerate_identifiers Ptr Volume
volume'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"volumeEnumerateIdentifiers" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data VolumeEnumerateIdentifiersMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeEnumerateIdentifiersMethodInfo a signature where
    overloadedMethod = volumeEnumerateIdentifiers

instance O.OverloadedMethodInfo VolumeEnumerateIdentifiersMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeEnumerateIdentifiers",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeEnumerateIdentifiers"
        }


#endif

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

foreign import ccall "g_volume_get_activation_root" g_volume_get_activation_root :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO (Ptr Gio.File.File)

-- | Gets the activation root for a t'GI.Gio.Interfaces.Volume.Volume' if it is known ahead of
-- mount time. Returns 'P.Nothing' otherwise. If not 'P.Nothing' and if /@volume@/
-- is mounted, then the result of 'GI.Gio.Interfaces.Mount.mountGetRoot' on the
-- t'GI.Gio.Interfaces.Mount.Mount' object obtained from 'GI.Gio.Interfaces.Volume.volumeGetMount' will always
-- either be equal or a prefix of what this function returns. In
-- other words, in code
-- 
-- 
-- === /C code/
-- >
-- >  GMount *mount;
-- >  GFile *mount_root
-- >  GFile *volume_activation_root;
-- >
-- >  mount = g_volume_get_mount (volume); // mounted, so never NULL
-- >  mount_root = g_mount_get_root (mount);
-- >  volume_activation_root = g_volume_get_activation_root (volume); // assume not NULL
-- 
-- then the expression
-- 
-- === /C code/
-- >
-- >  (g_file_has_prefix (volume_activation_root, mount_root) ||
-- >   g_file_equal (volume_activation_root, mount_root))
-- 
-- will always be 'P.True'.
-- 
-- Activation roots are typically used in t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'
-- implementations to find the underlying mount to shadow, see
-- 'GI.Gio.Interfaces.Mount.mountIsShadowed' for more details.
-- 
-- /Since: 2.18/
volumeGetActivationRoot ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m (Maybe Gio.File.File)
    -- ^ __Returns:__ the activation root of /@volume@/
    --     or 'P.Nothing'. Use 'GI.GObject.Objects.Object.objectUnref' to free.
volumeGetActivationRoot :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m (Maybe File)
volumeGetActivationRoot a
volume = IO (Maybe File) -> m (Maybe File)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr File
result <- Ptr Volume -> IO (Ptr File)
g_volume_get_activation_root Ptr Volume
volume'
    Maybe File
maybeResult <- Ptr File -> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr File
result ((Ptr File -> IO File) -> IO (Maybe File))
-> (Ptr File -> IO File) -> IO (Maybe File)
forall a b. (a -> b) -> a -> b
$ \Ptr File
result' -> do
        File
result'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result'
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Maybe File -> IO (Maybe File)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe File
maybeResult

#if defined(ENABLE_OVERLOADING)
data VolumeGetActivationRootMethodInfo
instance (signature ~ (m (Maybe Gio.File.File)), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetActivationRootMethodInfo a signature where
    overloadedMethod = volumeGetActivationRoot

instance O.OverloadedMethodInfo VolumeGetActivationRootMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetActivationRoot",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetActivationRoot"
        }


#endif

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

foreign import ccall "g_volume_get_drive" g_volume_get_drive :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO (Ptr Gio.Drive.Drive)

-- | Gets the drive for the /@volume@/.
volumeGetDrive ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m (Maybe Gio.Drive.Drive)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Drive.Drive' or 'P.Nothing' if /@volume@/ is not
    --     associated with a drive. The returned object should be unreffed
    --     with 'GI.GObject.Objects.Object.objectUnref' when no longer needed.
volumeGetDrive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m (Maybe Drive)
volumeGetDrive a
volume = IO (Maybe Drive) -> m (Maybe Drive)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Drive) -> m (Maybe Drive))
-> IO (Maybe Drive) -> m (Maybe Drive)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr Drive
result <- Ptr Volume -> IO (Ptr Drive)
g_volume_get_drive Ptr Volume
volume'
    Maybe Drive
maybeResult <- Ptr Drive -> (Ptr Drive -> IO Drive) -> IO (Maybe Drive)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Drive
result ((Ptr Drive -> IO Drive) -> IO (Maybe Drive))
-> (Ptr Drive -> IO Drive) -> IO (Maybe Drive)
forall a b. (a -> b) -> a -> b
$ \Ptr Drive
result' -> do
        Drive
result'' <- ((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'
        Drive -> IO Drive
forall (m :: * -> *) a. Monad m => a -> m a
return Drive
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Maybe Drive -> IO (Maybe Drive)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drive
maybeResult

#if defined(ENABLE_OVERLOADING)
data VolumeGetDriveMethodInfo
instance (signature ~ (m (Maybe Gio.Drive.Drive)), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetDriveMethodInfo a signature where
    overloadedMethod = volumeGetDrive

instance O.OverloadedMethodInfo VolumeGetDriveMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetDrive",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetDrive"
        }


#endif

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

foreign import ccall "g_volume_get_icon" g_volume_get_icon :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the icon for /@volume@/.
volumeGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon'.
    --     The returned object should be unreffed with 'GI.GObject.Objects.Object.objectUnref'
    --     when no longer needed.
volumeGetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m Icon
volumeGetIcon a
volume = IO Icon -> m Icon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Icon -> m Icon) -> IO Icon -> m Icon
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr Icon
result <- Ptr Volume -> IO (Ptr Icon)
g_volume_get_icon Ptr Volume
volume'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"volumeGetIcon" Ptr Icon
result
    Icon
result' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
data VolumeGetIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetIconMethodInfo a signature where
    overloadedMethod = volumeGetIcon

instance O.OverloadedMethodInfo VolumeGetIconMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetIcon",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetIcon"
        }


#endif

-- method Volume::get_identifier
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType = TInterface Name { namespace = "Gio" , name = "Volume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVolume" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "kind"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the kind of identifier to return"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "g_volume_get_identifier" g_volume_get_identifier :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    CString ->                              -- kind : TBasicType TUTF8
    IO CString

-- | Gets the identifier of the given kind for /@volume@/.
-- See the [introduction][volume-identifier] for more
-- information about volume identifiers.
volumeGetIdentifier ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> T.Text
    -- ^ /@kind@/: the kind of identifier to return
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a newly allocated string containing the
    --     requested identifier, or 'P.Nothing' if the t'GI.Gio.Interfaces.Volume.Volume'
    --     doesn\'t have this kind of identifier
volumeGetIdentifier :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> Text -> m (Maybe Text)
volumeGetIdentifier a
volume Text
kind = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    CString
kind' <- Text -> IO CString
textToCString Text
kind
    CString
result <- Ptr Volume -> CString -> IO CString
g_volume_get_identifier Ptr Volume
volume' CString
kind'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
kind'
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data VolumeGetIdentifierMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetIdentifierMethodInfo a signature where
    overloadedMethod = volumeGetIdentifier

instance O.OverloadedMethodInfo VolumeGetIdentifierMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetIdentifier",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetIdentifier"
        }


#endif

-- method Volume::get_mount
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType = TInterface Name { namespace = "Gio" , name = "Volume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVolume" , 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_get_mount" g_volume_get_mount :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO (Ptr Gio.Mount.Mount)

-- | Gets the mount for the /@volume@/.
volumeGetMount ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m (Maybe Gio.Mount.Mount)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Mount.Mount' or 'P.Nothing' if /@volume@/ isn\'t mounted.
    --     The returned object should be unreffed with 'GI.GObject.Objects.Object.objectUnref'
    --     when no longer needed.
volumeGetMount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m (Maybe Mount)
volumeGetMount a
volume = IO (Maybe Mount) -> m (Maybe Mount)
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 Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr Mount
result <- Ptr Volume -> IO (Ptr Mount)
g_volume_get_mount Ptr Volume
volume'
    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 (m :: * -> *) a. Monad m => a -> m a
return Mount
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Maybe Mount -> IO (Maybe Mount)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Mount
maybeResult

#if defined(ENABLE_OVERLOADING)
data VolumeGetMountMethodInfo
instance (signature ~ (m (Maybe Gio.Mount.Mount)), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetMountMethodInfo a signature where
    overloadedMethod = volumeGetMount

instance O.OverloadedMethodInfo VolumeGetMountMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetMount",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetMount"
        }


#endif

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

foreign import ccall "g_volume_get_name" g_volume_get_name :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO CString

-- | Gets the name of /@volume@/.
volumeGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m T.Text
    -- ^ __Returns:__ the name for the given /@volume@/. The returned string should
    --     be freed with 'GI.GLib.Functions.free' when no longer needed.
volumeGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m Text
volumeGetName a
volume = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    CString
result <- Ptr Volume -> IO CString
g_volume_get_name Ptr Volume
volume'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"volumeGetName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data VolumeGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetNameMethodInfo a signature where
    overloadedMethod = volumeGetName

instance O.OverloadedMethodInfo VolumeGetNameMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetName",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetName"
        }


#endif

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

foreign import ccall "g_volume_get_sort_key" g_volume_get_sort_key :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO CString

-- | Gets the sort key for /@volume@/, if any.
-- 
-- /Since: 2.32/
volumeGetSortKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ Sorting key for /@volume@/ or 'P.Nothing' if no such key is available
volumeGetSortKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m (Maybe Text)
volumeGetSortKey a
volume = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    CString
result <- Ptr Volume -> IO CString
g_volume_get_sort_key Ptr Volume
volume'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data VolumeGetSortKeyMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetSortKeyMethodInfo a signature where
    overloadedMethod = volumeGetSortKey

instance O.OverloadedMethodInfo VolumeGetSortKeyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetSortKey",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetSortKey"
        }


#endif

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

foreign import ccall "g_volume_get_symbolic_icon" g_volume_get_symbolic_icon :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the symbolic icon for /@volume@/.
-- 
-- /Since: 2.34/
volumeGetSymbolicIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon'.
    --     The returned object should be unreffed with 'GI.GObject.Objects.Object.objectUnref'
    --     when no longer needed.
volumeGetSymbolicIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m Icon
volumeGetSymbolicIcon a
volume = IO Icon -> m Icon
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Icon -> m Icon) -> IO Icon -> m Icon
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr Icon
result <- Ptr Volume -> IO (Ptr Icon)
g_volume_get_symbolic_icon Ptr Volume
volume'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"volumeGetSymbolicIcon" Ptr Icon
result
    Icon
result' <- ((ManagedPtr Icon -> Icon) -> Ptr Icon -> IO Icon
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Icon -> Icon
Gio.Icon.Icon) Ptr Icon
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
data VolumeGetSymbolicIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetSymbolicIconMethodInfo a signature where
    overloadedMethod = volumeGetSymbolicIcon

instance O.OverloadedMethodInfo VolumeGetSymbolicIconMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetSymbolicIcon",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetSymbolicIcon"
        }


#endif

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

foreign import ccall "g_volume_get_uuid" g_volume_get_uuid :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO CString

-- | Gets the UUID for the /@volume@/. The reference is typically based on
-- the file system UUID for the volume in question and should be
-- considered an opaque string. Returns 'P.Nothing' if there is no UUID
-- available.
volumeGetUuid ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the UUID for /@volume@/ or 'P.Nothing' if no UUID
    --     can be computed.
    --     The returned string should be freed with 'GI.GLib.Functions.free'
    --     when no longer needed.
volumeGetUuid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m (Maybe Text)
volumeGetUuid a
volume = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    CString
result <- Ptr Volume -> IO CString
g_volume_get_uuid Ptr Volume
volume'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data VolumeGetUuidMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeGetUuidMethodInfo a signature where
    overloadedMethod = volumeGetUuid

instance O.OverloadedMethodInfo VolumeGetUuidMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeGetUuid",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeGetUuid"
        }


#endif

-- method Volume::mount
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "volume"
--           , argType = TInterface Name { namespace = "Gio" , name = "Volume" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVolume" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountMountFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags affecting the operation"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mount_operation"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "MountOperation" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GMountOperation or %NULL to avoid user interaction"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "optional #GCancellable object, %NULL to ignore"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncReadyCallback, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 5
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data that gets passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_volume_mount" g_volume_mount :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "Gio", name = "MountMountFlags"})
    Ptr Gio.MountOperation.MountOperation -> -- mount_operation : TInterface (Name {namespace = "Gio", name = "MountOperation"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Mounts a volume. This is an asynchronous operation, and is
-- finished by calling 'GI.Gio.Interfaces.Volume.volumeMountFinish' with the /@volume@/
-- and t'GI.Gio.Interfaces.AsyncResult.AsyncResult' returned in the /@callback@/.
volumeMount ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> [Gio.Flags.MountMountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> Maybe (b)
    -- ^ /@mountOperation@/: a t'GI.Gio.Objects.MountOperation.MountOperation' or 'P.Nothing' to avoid user interaction
    -> Maybe (c)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback', or 'P.Nothing'
    -> m ()
volumeMount :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsVolume a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountMountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
volumeMount a
volume [MountMountFlags]
flags Maybe b
mountOperation Maybe c
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    let flags' :: CUInt
flags' = [MountMountFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MountMountFlags]
flags
    Ptr MountOperation
maybeMountOperation <- case Maybe b
mountOperation of
        Maybe b
Nothing -> Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
forall a. Ptr a
nullPtr
        Just b
jMountOperation -> do
            Ptr MountOperation
jMountOperation' <- b -> IO (Ptr MountOperation)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMountOperation
            Ptr MountOperation -> IO (Ptr MountOperation)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr MountOperation
jMountOperation'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Volume
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_volume_mount Ptr Volume
volume' CUInt
flags' Ptr MountOperation
maybeMountOperation Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mountOperation b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VolumeMountMethodInfo
instance (signature ~ ([Gio.Flags.MountMountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsVolume a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod VolumeMountMethodInfo a signature where
    overloadedMethod = volumeMount

instance O.OverloadedMethodInfo VolumeMountMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeMount",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeMount"
        }


#endif

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

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

-- | Finishes mounting a volume. If any errors occurred during the operation,
-- /@error@/ will be set to contain the errors and 'P.False' will be returned.
-- 
-- If the mount operation succeeded, 'GI.Gio.Interfaces.Volume.volumeGetMount' on /@volume@/
-- is guaranteed to return the mount right after calling this
-- function; there\'s no need to listen for the \'mount-added\' signal on
-- t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor'.
volumeMountFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
volumeMountFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsVolume a, IsAsyncResult b) =>
a -> b -> m ()
volumeMountFinish a
volume b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Volume -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_volume_mount_finish Ptr Volume
volume' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

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

instance O.OverloadedMethodInfo VolumeMountFinishMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeMountFinish",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeMountFinish"
        }


#endif

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

foreign import ccall "g_volume_should_automount" g_volume_should_automount :: 
    Ptr Volume ->                           -- volume : TInterface (Name {namespace = "Gio", name = "Volume"})
    IO CInt

-- | Returns whether the volume should be automatically mounted.
volumeShouldAutomount ::
    (B.CallStack.HasCallStack, MonadIO m, IsVolume a) =>
    a
    -- ^ /@volume@/: a t'GI.Gio.Interfaces.Volume.Volume'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the volume should be automatically mounted
volumeShouldAutomount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVolume a) =>
a -> m Bool
volumeShouldAutomount a
volume = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Volume
volume' <- a -> IO (Ptr Volume)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
volume
    CInt
result <- Ptr Volume -> IO CInt
g_volume_should_automount Ptr Volume
volume'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
volume
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data VolumeShouldAutomountMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsVolume a) => O.OverloadedMethod VolumeShouldAutomountMethodInfo a signature where
    overloadedMethod = volumeShouldAutomount

instance O.OverloadedMethodInfo VolumeShouldAutomountMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Gio.Interfaces.Volume.volumeShouldAutomount",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-gio-2.0.28/docs/GI-Gio-Interfaces-Volume.html#v:volumeShouldAutomount"
        }


#endif

-- signal Volume::changed
-- | Emitted when the volume has been changed.
type VolumeChangedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `VolumeChangedCallback`@.
noVolumeChangedCallback :: Maybe VolumeChangedCallback
noVolumeChangedCallback :: Maybe (IO ())
noVolumeChangedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_VolumeChangedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_VolumeChanged :: MonadIO m => VolumeChangedCallback -> m (GClosure C_VolumeChangedCallback)
genClosure_VolumeChanged :: forall (m :: * -> *).
MonadIO m =>
IO () -> m (GClosure C_VolumeChangedCallback)
genClosure_VolumeChanged IO ()
cb = IO (GClosure C_VolumeChangedCallback)
-> m (GClosure C_VolumeChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VolumeChangedCallback)
 -> m (GClosure C_VolumeChangedCallback))
-> IO (GClosure C_VolumeChangedCallback)
-> m (GClosure C_VolumeChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_VolumeChangedCallback
cb' = IO () -> C_VolumeChangedCallback
wrap_VolumeChangedCallback IO ()
cb
    C_VolumeChangedCallback -> IO (FunPtr C_VolumeChangedCallback)
mk_VolumeChangedCallback C_VolumeChangedCallback
cb' IO (FunPtr C_VolumeChangedCallback)
-> (FunPtr C_VolumeChangedCallback
    -> IO (GClosure C_VolumeChangedCallback))
-> IO (GClosure C_VolumeChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VolumeChangedCallback
-> IO (GClosure C_VolumeChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VolumeChangedCallback` into a `C_VolumeChangedCallback`.
wrap_VolumeChangedCallback ::
    VolumeChangedCallback ->
    C_VolumeChangedCallback
wrap_VolumeChangedCallback :: IO () -> C_VolumeChangedCallback
wrap_VolumeChangedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [changed](#signal:changed) 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' volume #changed callback
-- @
-- 
-- 
onVolumeChanged :: (IsVolume a, MonadIO m) => a -> VolumeChangedCallback -> m SignalHandlerId
onVolumeChanged :: forall a (m :: * -> *).
(IsVolume a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onVolumeChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_VolumeChangedCallback
cb' = IO () -> C_VolumeChangedCallback
wrap_VolumeChangedCallback IO ()
cb
    FunPtr C_VolumeChangedCallback
cb'' <- C_VolumeChangedCallback -> IO (FunPtr C_VolumeChangedCallback)
mk_VolumeChangedCallback C_VolumeChangedCallback
cb'
    a
-> Text
-> FunPtr C_VolumeChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_VolumeChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [changed](#signal:changed) 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' volume #changed callback
-- @
-- 
-- 
afterVolumeChanged :: (IsVolume a, MonadIO m) => a -> VolumeChangedCallback -> m SignalHandlerId
afterVolumeChanged :: forall a (m :: * -> *).
(IsVolume a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
afterVolumeChanged a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_VolumeChangedCallback
cb' = IO () -> C_VolumeChangedCallback
wrap_VolumeChangedCallback IO ()
cb
    FunPtr C_VolumeChangedCallback
cb'' <- C_VolumeChangedCallback -> IO (FunPtr C_VolumeChangedCallback)
mk_VolumeChangedCallback C_VolumeChangedCallback
cb'
    a
-> Text
-> FunPtr C_VolumeChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"changed" FunPtr C_VolumeChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeChangedSignalInfo
instance SignalInfo VolumeChangedSignalInfo where
    type HaskellCallbackType VolumeChangedSignalInfo = VolumeChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeChangedCallback cb
        cb'' <- mk_VolumeChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail

#endif

-- signal Volume::removed
-- | This signal is emitted when the t'GI.Gio.Interfaces.Volume.Volume' have been removed. If
-- the recipient is holding references to the object they should
-- release them so the object can be finalized.
type VolumeRemovedCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `VolumeRemovedCallback`@.
noVolumeRemovedCallback :: Maybe VolumeRemovedCallback
noVolumeRemovedCallback :: Maybe (IO ())
noVolumeRemovedCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_VolumeRemovedCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

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

-- | Wrap the callback into a `GClosure`.
genClosure_VolumeRemoved :: MonadIO m => VolumeRemovedCallback -> m (GClosure C_VolumeRemovedCallback)
genClosure_VolumeRemoved :: forall (m :: * -> *).
MonadIO m =>
IO () -> m (GClosure C_VolumeChangedCallback)
genClosure_VolumeRemoved IO ()
cb = IO (GClosure C_VolumeChangedCallback)
-> m (GClosure C_VolumeChangedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_VolumeChangedCallback)
 -> m (GClosure C_VolumeChangedCallback))
-> IO (GClosure C_VolumeChangedCallback)
-> m (GClosure C_VolumeChangedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_VolumeChangedCallback
cb' = IO () -> C_VolumeChangedCallback
wrap_VolumeRemovedCallback IO ()
cb
    C_VolumeChangedCallback -> IO (FunPtr C_VolumeChangedCallback)
mk_VolumeRemovedCallback C_VolumeChangedCallback
cb' IO (FunPtr C_VolumeChangedCallback)
-> (FunPtr C_VolumeChangedCallback
    -> IO (GClosure C_VolumeChangedCallback))
-> IO (GClosure C_VolumeChangedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_VolumeChangedCallback
-> IO (GClosure C_VolumeChangedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `VolumeRemovedCallback` into a `C_VolumeRemovedCallback`.
wrap_VolumeRemovedCallback ::
    VolumeRemovedCallback ->
    C_VolumeRemovedCallback
wrap_VolumeRemovedCallback :: IO () -> C_VolumeChangedCallback
wrap_VolumeRemovedCallback IO ()
_cb Ptr ()
_ Ptr ()
_ = do
    IO ()
_cb 


-- | Connect a signal handler for the [removed](#signal:removed) 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' volume #removed callback
-- @
-- 
-- 
onVolumeRemoved :: (IsVolume a, MonadIO m) => a -> VolumeRemovedCallback -> m SignalHandlerId
onVolumeRemoved :: forall a (m :: * -> *).
(IsVolume a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onVolumeRemoved a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_VolumeChangedCallback
cb' = IO () -> C_VolumeChangedCallback
wrap_VolumeRemovedCallback IO ()
cb
    FunPtr C_VolumeChangedCallback
cb'' <- C_VolumeChangedCallback -> IO (FunPtr C_VolumeChangedCallback)
mk_VolumeRemovedCallback C_VolumeChangedCallback
cb'
    a
-> Text
-> FunPtr C_VolumeChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"removed" FunPtr C_VolumeChangedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [removed](#signal:removed) 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' volume #removed callback
-- @
-- 
-- 
afterVolumeRemoved :: (IsVolume a, MonadIO m) => a -> VolumeRemovedCallback -> m SignalHandlerId
afterVolumeRemoved :: forall a (m :: * -> *).
(IsVolume a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
afterVolumeRemoved a
obj IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
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 cb' :: C_VolumeChangedCallback
cb' = IO () -> C_VolumeChangedCallback
wrap_VolumeRemovedCallback IO ()
cb
    FunPtr C_VolumeChangedCallback
cb'' <- C_VolumeChangedCallback -> IO (FunPtr C_VolumeChangedCallback)
mk_VolumeRemovedCallback C_VolumeChangedCallback
cb'
    a
-> Text
-> FunPtr C_VolumeChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"removed" FunPtr C_VolumeChangedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VolumeRemovedSignalInfo
instance SignalInfo VolumeRemovedSignalInfo where
    type HaskellCallbackType VolumeRemovedSignalInfo = VolumeRemovedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VolumeRemovedCallback cb
        cb'' <- mk_VolumeRemovedCallback cb'
        connectSignalFunPtr obj "removed" cb'' connectMode detail

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Volume = VolumeSignalList
type VolumeSignalList = ('[ '("changed", VolumeChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("removed", VolumeRemovedSignalInfo)] :: [(Symbol, *)])

#endif