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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gio.Interfaces.Mount.Mount' interface represents user-visible mounts. Note, when
-- porting from GnomeVFS, t'GI.Gio.Interfaces.Mount.Mount' is the moral equivalent of @/GnomeVFSVolume/@.
-- 
-- t'GI.Gio.Interfaces.Mount.Mount' is a \"mounted\" filesystem that you can access. Mounted is in
-- quotes because it\'s not the same as a unix mount, it might be a gvfs
-- mount, but you can still access the files on it if you use GIO. Might or
-- might not be related to a volume object.
-- 
-- Unmounting a t'GI.Gio.Interfaces.Mount.Mount' 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 unmount a t'GI.Gio.Interfaces.Mount.Mount' instance, first call
-- 'GI.Gio.Interfaces.Mount.mountUnmountWithOperation' with (at least) the t'GI.Gio.Interfaces.Mount.Mount' instance and a
-- t'GI.Gio.Callbacks.AsyncReadyCallback'.  The callback will be fired when the
-- operation has resolved (either with success or failure), and a
-- t'GI.Gio.Interfaces.AsyncResult.AsyncResult' structure will be passed to the callback.  That
-- callback should then call 'GI.Gio.Interfaces.Mount.mountUnmountWithOperationFinish' with the t'GI.Gio.Interfaces.Mount.Mount'
-- 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.Mount.mountUnmountWithOperationFinish'
-- is called, then it will be filled with any error information.

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

module GI.Gio.Interfaces.Mount
    ( 

-- * Exported types
    Mount(..)                               ,
    IsMount                                 ,
    toMount                                 ,


 -- * 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.Mount#g:method:canEject"), [canUnmount]("GI.Gio.Interfaces.Mount#g:method:canUnmount"), [eject]("GI.Gio.Interfaces.Mount#g:method:eject"), [ejectFinish]("GI.Gio.Interfaces.Mount#g:method:ejectFinish"), [ejectWithOperation]("GI.Gio.Interfaces.Mount#g:method:ejectWithOperation"), [ejectWithOperationFinish]("GI.Gio.Interfaces.Mount#g:method:ejectWithOperationFinish"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [guessContentType]("GI.Gio.Interfaces.Mount#g:method:guessContentType"), [guessContentTypeFinish]("GI.Gio.Interfaces.Mount#g:method:guessContentTypeFinish"), [guessContentTypeSync]("GI.Gio.Interfaces.Mount#g:method:guessContentTypeSync"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isShadowed]("GI.Gio.Interfaces.Mount#g:method:isShadowed"), [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"), [remount]("GI.Gio.Interfaces.Mount#g:method:remount"), [remountFinish]("GI.Gio.Interfaces.Mount#g:method:remountFinish"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [shadow]("GI.Gio.Interfaces.Mount#g:method:shadow"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unmount]("GI.Gio.Interfaces.Mount#g:method:unmount"), [unmountFinish]("GI.Gio.Interfaces.Mount#g:method:unmountFinish"), [unmountWithOperation]("GI.Gio.Interfaces.Mount#g:method:unmountWithOperation"), [unmountWithOperationFinish]("GI.Gio.Interfaces.Mount#g:method:unmountWithOperationFinish"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [unshadow]("GI.Gio.Interfaces.Mount#g:method:unshadow"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDefaultLocation]("GI.Gio.Interfaces.Mount#g:method:getDefaultLocation"), [getDrive]("GI.Gio.Interfaces.Mount#g:method:getDrive"), [getIcon]("GI.Gio.Interfaces.Mount#g:method:getIcon"), [getName]("GI.Gio.Interfaces.Mount#g:method:getName"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRoot]("GI.Gio.Interfaces.Mount#g:method:getRoot"), [getSortKey]("GI.Gio.Interfaces.Mount#g:method:getSortKey"), [getSymbolicIcon]("GI.Gio.Interfaces.Mount#g:method:getSymbolicIcon"), [getUuid]("GI.Gio.Interfaces.Mount#g:method:getUuid"), [getVolume]("GI.Gio.Interfaces.Mount#g:method:getVolume").
-- 
-- ==== 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)
    ResolveMountMethod                      ,
#endif

-- ** canEject #method:canEject#

#if defined(ENABLE_OVERLOADING)
    MountCanEjectMethodInfo                 ,
#endif
    mountCanEject                           ,


-- ** canUnmount #method:canUnmount#

#if defined(ENABLE_OVERLOADING)
    MountCanUnmountMethodInfo               ,
#endif
    mountCanUnmount                         ,


-- ** eject #method:eject#

#if defined(ENABLE_OVERLOADING)
    MountEjectMethodInfo                    ,
#endif
    mountEject                              ,


-- ** ejectFinish #method:ejectFinish#

#if defined(ENABLE_OVERLOADING)
    MountEjectFinishMethodInfo              ,
#endif
    mountEjectFinish                        ,


-- ** ejectWithOperation #method:ejectWithOperation#

#if defined(ENABLE_OVERLOADING)
    MountEjectWithOperationMethodInfo       ,
#endif
    mountEjectWithOperation                 ,


-- ** ejectWithOperationFinish #method:ejectWithOperationFinish#

#if defined(ENABLE_OVERLOADING)
    MountEjectWithOperationFinishMethodInfo ,
#endif
    mountEjectWithOperationFinish           ,


-- ** getDefaultLocation #method:getDefaultLocation#

#if defined(ENABLE_OVERLOADING)
    MountGetDefaultLocationMethodInfo       ,
#endif
    mountGetDefaultLocation                 ,


-- ** getDrive #method:getDrive#

#if defined(ENABLE_OVERLOADING)
    MountGetDriveMethodInfo                 ,
#endif
    mountGetDrive                           ,


-- ** getIcon #method:getIcon#

#if defined(ENABLE_OVERLOADING)
    MountGetIconMethodInfo                  ,
#endif
    mountGetIcon                            ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    MountGetNameMethodInfo                  ,
#endif
    mountGetName                            ,


-- ** getRoot #method:getRoot#

#if defined(ENABLE_OVERLOADING)
    MountGetRootMethodInfo                  ,
#endif
    mountGetRoot                            ,


-- ** getSortKey #method:getSortKey#

#if defined(ENABLE_OVERLOADING)
    MountGetSortKeyMethodInfo               ,
#endif
    mountGetSortKey                         ,


-- ** getSymbolicIcon #method:getSymbolicIcon#

#if defined(ENABLE_OVERLOADING)
    MountGetSymbolicIconMethodInfo          ,
#endif
    mountGetSymbolicIcon                    ,


-- ** getUuid #method:getUuid#

#if defined(ENABLE_OVERLOADING)
    MountGetUuidMethodInfo                  ,
#endif
    mountGetUuid                            ,


-- ** getVolume #method:getVolume#

#if defined(ENABLE_OVERLOADING)
    MountGetVolumeMethodInfo                ,
#endif
    mountGetVolume                          ,


-- ** guessContentType #method:guessContentType#

#if defined(ENABLE_OVERLOADING)
    MountGuessContentTypeMethodInfo         ,
#endif
    mountGuessContentType                   ,


-- ** guessContentTypeFinish #method:guessContentTypeFinish#

#if defined(ENABLE_OVERLOADING)
    MountGuessContentTypeFinishMethodInfo   ,
#endif
    mountGuessContentTypeFinish             ,


-- ** guessContentTypeSync #method:guessContentTypeSync#

#if defined(ENABLE_OVERLOADING)
    MountGuessContentTypeSyncMethodInfo     ,
#endif
    mountGuessContentTypeSync               ,


-- ** isShadowed #method:isShadowed#

#if defined(ENABLE_OVERLOADING)
    MountIsShadowedMethodInfo               ,
#endif
    mountIsShadowed                         ,


-- ** remount #method:remount#

#if defined(ENABLE_OVERLOADING)
    MountRemountMethodInfo                  ,
#endif
    mountRemount                            ,


-- ** remountFinish #method:remountFinish#

#if defined(ENABLE_OVERLOADING)
    MountRemountFinishMethodInfo            ,
#endif
    mountRemountFinish                      ,


-- ** shadow #method:shadow#

#if defined(ENABLE_OVERLOADING)
    MountShadowMethodInfo                   ,
#endif
    mountShadow                             ,


-- ** unmount #method:unmount#

#if defined(ENABLE_OVERLOADING)
    MountUnmountMethodInfo                  ,
#endif
    mountUnmount                            ,


-- ** unmountFinish #method:unmountFinish#

#if defined(ENABLE_OVERLOADING)
    MountUnmountFinishMethodInfo            ,
#endif
    mountUnmountFinish                      ,


-- ** unmountWithOperation #method:unmountWithOperation#

#if defined(ENABLE_OVERLOADING)
    MountUnmountWithOperationMethodInfo     ,
#endif
    mountUnmountWithOperation               ,


-- ** unmountWithOperationFinish #method:unmountWithOperationFinish#

#if defined(ENABLE_OVERLOADING)
    MountUnmountWithOperationFinishMethodInfo,
#endif
    mountUnmountWithOperationFinish         ,


-- ** unshadow #method:unshadow#

#if defined(ENABLE_OVERLOADING)
    MountUnshadowMethodInfo                 ,
#endif
    mountUnshadow                           ,




 -- * Signals


-- ** changed #signal:changed#

    MountChangedCallback                    ,
#if defined(ENABLE_OVERLOADING)
    MountChangedSignalInfo                  ,
#endif
    afterMountChanged                       ,
    onMountChanged                          ,


-- ** preUnmount #signal:preUnmount#

    MountPreUnmountCallback                 ,
#if defined(ENABLE_OVERLOADING)
    MountPreUnmountSignalInfo               ,
#endif
    afterMountPreUnmount                    ,
    onMountPreUnmount                       ,


-- ** unmounted #signal:unmounted#

    MountUnmountedCallback                  ,
#if defined(ENABLE_OVERLOADING)
    MountUnmountedSignalInfo                ,
#endif
    afterMountUnmounted                     ,
    onMountUnmounted                        ,




    ) 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.Coerce as Coerce
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.Volume as Gio.Volume
import {-# SOURCE #-} qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.Gio.Objects.MountOperation as Gio.MountOperation

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

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

foreign import ccall "g_mount_get_type"
    c_g_mount_get_type :: IO B.Types.GType

instance B.Types.TypedObject Mount where
    glibType :: IO GType
glibType = IO GType
c_g_mount_get_type

instance B.Types.GObject Mount

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

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

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

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

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

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMountMethod (t :: Symbol) (o :: *) :: * where
    ResolveMountMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveMountMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveMountMethod "canEject" o = MountCanEjectMethodInfo
    ResolveMountMethod "canUnmount" o = MountCanUnmountMethodInfo
    ResolveMountMethod "eject" o = MountEjectMethodInfo
    ResolveMountMethod "ejectFinish" o = MountEjectFinishMethodInfo
    ResolveMountMethod "ejectWithOperation" o = MountEjectWithOperationMethodInfo
    ResolveMountMethod "ejectWithOperationFinish" o = MountEjectWithOperationFinishMethodInfo
    ResolveMountMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveMountMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveMountMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveMountMethod "guessContentType" o = MountGuessContentTypeMethodInfo
    ResolveMountMethod "guessContentTypeFinish" o = MountGuessContentTypeFinishMethodInfo
    ResolveMountMethod "guessContentTypeSync" o = MountGuessContentTypeSyncMethodInfo
    ResolveMountMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveMountMethod "isShadowed" o = MountIsShadowedMethodInfo
    ResolveMountMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveMountMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveMountMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveMountMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveMountMethod "remount" o = MountRemountMethodInfo
    ResolveMountMethod "remountFinish" o = MountRemountFinishMethodInfo
    ResolveMountMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveMountMethod "shadow" o = MountShadowMethodInfo
    ResolveMountMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveMountMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveMountMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveMountMethod "unmount" o = MountUnmountMethodInfo
    ResolveMountMethod "unmountFinish" o = MountUnmountFinishMethodInfo
    ResolveMountMethod "unmountWithOperation" o = MountUnmountWithOperationMethodInfo
    ResolveMountMethod "unmountWithOperationFinish" o = MountUnmountWithOperationFinishMethodInfo
    ResolveMountMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveMountMethod "unshadow" o = MountUnshadowMethodInfo
    ResolveMountMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveMountMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveMountMethod "getDefaultLocation" o = MountGetDefaultLocationMethodInfo
    ResolveMountMethod "getDrive" o = MountGetDriveMethodInfo
    ResolveMountMethod "getIcon" o = MountGetIconMethodInfo
    ResolveMountMethod "getName" o = MountGetNameMethodInfo
    ResolveMountMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveMountMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveMountMethod "getRoot" o = MountGetRootMethodInfo
    ResolveMountMethod "getSortKey" o = MountGetSortKeyMethodInfo
    ResolveMountMethod "getSymbolicIcon" o = MountGetSymbolicIconMethodInfo
    ResolveMountMethod "getUuid" o = MountGetUuidMethodInfo
    ResolveMountMethod "getVolume" o = MountGetVolumeMethodInfo
    ResolveMountMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveMountMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveMountMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveMountMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- method Mount::can_eject
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_can_eject" g_mount_can_eject :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO CInt

-- | Checks if /@mount@/ can be ejected.
mountCanEject ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@mount@/ can be ejected.
mountCanEject :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m Bool
mountCanEject a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    CInt
result <- Ptr Mount -> IO CInt
g_mount_can_eject Ptr Mount
mount'
    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
mount
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MountCanEjectMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMount a) => O.OverloadedMethod MountCanEjectMethodInfo a signature where
    overloadedMethod = mountCanEject

instance O.OverloadedMethodInfo MountCanEjectMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountCanEject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountCanEject"
        })


#endif

-- method Mount::can_unmount
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_can_unmount" g_mount_can_unmount :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO CInt

-- | Checks if /@mount@/ can be unmounted.
mountCanUnmount ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the /@mount@/ can be unmounted.
mountCanUnmount :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m Bool
mountCanUnmount a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    CInt
result <- Ptr Mount -> IO CInt
g_mount_can_unmount Ptr Mount
mount'
    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
mount
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MountCanUnmountMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMount a) => O.OverloadedMethod MountCanUnmountMethodInfo a signature where
    overloadedMethod = mountCanUnmount

instance O.OverloadedMethodInfo MountCanUnmountMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountCanUnmount",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountCanUnmount"
        })


#endif

-- method Mount::eject
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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 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_mount_eject" g_mount_eject :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    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 mountEject ["(Since version 2.22)","Use 'GI.Gio.Interfaces.Mount.mountEjectWithOperation' instead."] #-}
-- | Ejects a mount. This is an asynchronous operation, and is
-- finished by calling 'GI.Gio.Interfaces.Mount.mountEjectFinish' with the /@mount@/
-- and t'GI.Gio.Interfaces.AsyncResult.AsyncResult' data returned in the /@callback@/.
mountEject ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> [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 ()
mountEject :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsCancellable b) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
mountEject a
mount [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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_mount_eject Ptr Mount
mount' 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
mount
    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 MountEjectMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsMount a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod MountEjectMethodInfo a signature where
    overloadedMethod = mountEject

instance O.OverloadedMethodInfo MountEjectMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountEject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountEject"
        })


#endif

-- method Mount::eject_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_eject_finish" g_mount_eject_finish :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED mountEjectFinish ["(Since version 2.22)","Use 'GI.Gio.Interfaces.Mount.mountEjectWithOperationFinish' instead."] #-}
-- | Finishes ejecting a mount. If any errors occurred during the operation,
-- /@error@/ will be set to contain the errors and 'P.False' will be returned.
mountEjectFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mountEjectFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsAsyncResult b) =>
a -> b -> m ()
mountEjectFinish a
mount 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_mount_eject_finish Ptr Mount
mount' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
        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 MountEjectFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod MountEjectFinishMethodInfo a signature where
    overloadedMethod = mountEjectFinish

instance O.OverloadedMethodInfo MountEjectFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountEjectFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountEjectFinish"
        })


#endif

-- method Mount::eject_with_operation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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 avoid\n    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_mount_eject_with_operation" g_mount_eject_with_operation :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    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 mount. This is an asynchronous operation, and is
-- finished by calling 'GI.Gio.Interfaces.Mount.mountEjectWithOperationFinish' with the /@mount@/
-- and t'GI.Gio.Interfaces.AsyncResult.AsyncResult' data returned in the /@callback@/.
-- 
-- /Since: 2.22/
mountEjectWithOperation ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> [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 ()
mountEjectWithOperation :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsMount a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
mountEjectWithOperation a
mount [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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_mount_eject_with_operation Ptr Mount
mount' 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
mount
    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 MountEjectWithOperationMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsMount a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod MountEjectWithOperationMethodInfo a signature where
    overloadedMethod = mountEjectWithOperation

instance O.OverloadedMethodInfo MountEjectWithOperationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountEjectWithOperation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountEjectWithOperation"
        })


#endif

-- method Mount::eject_with_operation_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_eject_with_operation_finish" g_mount_eject_with_operation_finish :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes ejecting a mount. If any errors occurred during the operation,
-- /@error@/ will be set to contain the errors and 'P.False' will be returned.
-- 
-- /Since: 2.22/
mountEjectWithOperationFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mountEjectWithOperationFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsAsyncResult b) =>
a -> b -> m ()
mountEjectWithOperationFinish a
mount 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_mount_eject_with_operation_finish Ptr Mount
mount' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
        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 MountEjectWithOperationFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod MountEjectWithOperationFinishMethodInfo a signature where
    overloadedMethod = mountEjectWithOperationFinish

instance O.OverloadedMethodInfo MountEjectWithOperationFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountEjectWithOperationFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountEjectWithOperationFinish"
        })


#endif

-- method Mount::get_default_location
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_get_default_location" g_mount_get_default_location :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO (Ptr Gio.File.File)

-- | Gets the default location of /@mount@/. The default location of the given
-- /@mount@/ is a path that reflects the main entry point for the user (e.g.
-- the home directory, or the root of the volume).
mountGetDefaultLocation ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> m Gio.File.File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File'.
    --      The returned object should be unreffed with
    --      'GI.GObject.Objects.Object.objectUnref' when no longer needed.
mountGetDefaultLocation :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m File
mountGetDefaultLocation a
mount = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr File
result <- Ptr Mount -> IO (Ptr File)
g_mount_get_default_location Ptr Mount
mount'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mountGetDefaultLocation" Ptr File
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data MountGetDefaultLocationMethodInfo
instance (signature ~ (m Gio.File.File), MonadIO m, IsMount a) => O.OverloadedMethod MountGetDefaultLocationMethodInfo a signature where
    overloadedMethod = mountGetDefaultLocation

instance O.OverloadedMethodInfo MountGetDefaultLocationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetDefaultLocation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetDefaultLocation"
        })


#endif

-- method Mount::get_drive
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_get_drive" g_mount_get_drive :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO (Ptr Gio.Drive.Drive)

-- | Gets the drive for the /@mount@/.
-- 
-- This is a convenience method for getting the t'GI.Gio.Interfaces.Volume.Volume' and then
-- using that object to get the t'GI.Gio.Interfaces.Drive.Drive'.
mountGetDrive ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> m (Maybe Gio.Drive.Drive)
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Drive.Drive' or 'P.Nothing' if /@mount@/ is not
    --      associated with a volume or a drive.
    --      The returned object should be unreffed with
    --      'GI.GObject.Objects.Object.objectUnref' when no longer needed.
mountGetDrive :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m (Maybe Drive)
mountGetDrive a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr Drive
result <- Ptr Mount -> IO (Ptr Drive)
g_mount_get_drive Ptr Mount
mount'
    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
mount
    Maybe Drive -> IO (Maybe Drive)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Drive
maybeResult

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

instance O.OverloadedMethodInfo MountGetDriveMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetDrive",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetDrive"
        })


#endif

-- method Mount::get_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_get_icon" g_mount_get_icon :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the icon for /@mount@/.
mountGetIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> 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.
mountGetIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m Icon
mountGetIcon a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr Icon
result <- Ptr Mount -> IO (Ptr Icon)
g_mount_get_icon Ptr Mount
mount'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mountGetIcon" 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
mount
    Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
data MountGetIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m, IsMount a) => O.OverloadedMethod MountGetIconMethodInfo a signature where
    overloadedMethod = mountGetIcon

instance O.OverloadedMethodInfo MountGetIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetIcon"
        })


#endif

-- method Mount::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_get_name" g_mount_get_name :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO CString

-- | Gets the name of /@mount@/.
mountGetName ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> m T.Text
    -- ^ __Returns:__ the name for the given /@mount@/.
    --     The returned string should be freed with 'GI.GLib.Functions.free'
    --     when no longer needed.
mountGetName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m Text
mountGetName a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    CString
result <- Ptr Mount -> IO CString
g_mount_get_name Ptr Mount
mount'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mountGetName" 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
mount
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data MountGetNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsMount a) => O.OverloadedMethod MountGetNameMethodInfo a signature where
    overloadedMethod = mountGetName

instance O.OverloadedMethodInfo MountGetNameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetName"
        })


#endif

-- method Mount::get_root
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_get_root" g_mount_get_root :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO (Ptr Gio.File.File)

-- | Gets the root directory on /@mount@/.
mountGetRoot ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> m Gio.File.File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File'.
    --      The returned object should be unreffed with
    --      'GI.GObject.Objects.Object.objectUnref' when no longer needed.
mountGetRoot :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m File
mountGetRoot a
mount = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr File
result <- Ptr Mount -> IO (Ptr File)
g_mount_get_root Ptr Mount
mount'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mountGetRoot" Ptr File
result
    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
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data MountGetRootMethodInfo
instance (signature ~ (m Gio.File.File), MonadIO m, IsMount a) => O.OverloadedMethod MountGetRootMethodInfo a signature where
    overloadedMethod = mountGetRoot

instance O.OverloadedMethodInfo MountGetRootMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetRoot",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetRoot"
        })


#endif

-- method Mount::get_sort_key
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GMount." , 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_mount_get_sort_key" g_mount_get_sort_key :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO CString

-- | Gets the sort key for /@mount@/, if any.
-- 
-- /Since: 2.32/
mountGetSortKey ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: A t'GI.Gio.Interfaces.Mount.Mount'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ Sorting key for /@mount@/ or 'P.Nothing' if no such key is available.
mountGetSortKey :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m (Maybe Text)
mountGetSortKey a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    CString
result <- Ptr Mount -> IO CString
g_mount_get_sort_key Ptr Mount
mount'
    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
mount
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

instance O.OverloadedMethodInfo MountGetSortKeyMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetSortKey",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetSortKey"
        })


#endif

-- method Mount::get_symbolic_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_get_symbolic_icon" g_mount_get_symbolic_icon :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO (Ptr Gio.Icon.Icon)

-- | Gets the symbolic icon for /@mount@/.
-- 
-- /Since: 2.34/
mountGetSymbolicIcon ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> 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.
mountGetSymbolicIcon :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m Icon
mountGetSymbolicIcon a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr Icon
result <- Ptr Mount -> IO (Ptr Icon)
g_mount_get_symbolic_icon Ptr Mount
mount'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mountGetSymbolicIcon" 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
mount
    Icon -> IO Icon
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
data MountGetSymbolicIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m, IsMount a) => O.OverloadedMethod MountGetSymbolicIconMethodInfo a signature where
    overloadedMethod = mountGetSymbolicIcon

instance O.OverloadedMethodInfo MountGetSymbolicIconMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetSymbolicIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetSymbolicIcon"
        })


#endif

-- method Mount::get_uuid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_get_uuid" g_mount_get_uuid :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO CString

-- | Gets the UUID for the /@mount@/. The reference is typically based on
-- the file system UUID for the mount in question and should be
-- considered an opaque string. Returns 'P.Nothing' if there is no UUID
-- available.
mountGetUuid ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the UUID for /@mount@/ or 'P.Nothing' if no UUID
    --     can be computed.
    --     The returned string should be freed with 'GI.GLib.Functions.free'
    --     when no longer needed.
mountGetUuid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m (Maybe Text)
mountGetUuid a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    CString
result <- Ptr Mount -> IO CString
g_mount_get_uuid Ptr Mount
mount'
    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
mount
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

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

instance O.OverloadedMethodInfo MountGetUuidMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetUuid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetUuid"
        })


#endif

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

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

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

#if defined(ENABLE_OVERLOADING)
data MountGetVolumeMethodInfo
instance (signature ~ (m (Maybe Gio.Volume.Volume)), MonadIO m, IsMount a) => O.OverloadedMethod MountGetVolumeMethodInfo a signature where
    overloadedMethod = mountGetVolume

instance O.OverloadedMethodInfo MountGetVolumeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGetVolume",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGetVolume"
        })


#endif

-- method Mount::guess_content_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "force_rescan"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Whether to force a rescan of the content.\n    Otherwise a cached result will be used if available"
--                 , 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"
--                 , 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 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_mount_guess_content_type" g_mount_guess_content_type :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    CInt ->                                 -- force_rescan : TBasicType TBoolean
    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 ()

-- | Tries to guess the type of content stored on /@mount@/. Returns one or
-- more textual identifiers of well-known content types (typically
-- prefixed with \"x-content\/\"), e.g. x-content\/image-dcf for camera
-- memory cards. See the
-- <http://www.freedesktop.org/wiki/Specifications/shared-mime-info-spec shared-mime-info>
-- specification for more on x-content types.
-- 
-- This is an asynchronous operation (see
-- 'GI.Gio.Interfaces.Mount.mountGuessContentTypeSync' for the synchronous version), and
-- is finished by calling 'GI.Gio.Interfaces.Mount.mountGuessContentTypeFinish' with the
-- /@mount@/ and t'GI.Gio.Interfaces.AsyncResult.AsyncResult' data returned in the /@callback@/.
-- 
-- /Since: 2.18/
mountGuessContentType ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'
    -> Bool
    -- ^ /@forceRescan@/: Whether to force a rescan of the content.
    --     Otherwise a cached result will be used if available
    -> 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'
    -> m ()
mountGuessContentType :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsCancellable b) =>
a -> Bool -> Maybe b -> Maybe AsyncReadyCallback -> m ()
mountGuessContentType a
mount Bool
forceRescan 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    let forceRescan' :: CInt
forceRescan' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
forceRescan
    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 Mount
-> CInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_mount_guess_content_type Ptr Mount
mount' CInt
forceRescan' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
    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 MountGuessContentTypeMethodInfo
instance (signature ~ (Bool -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsMount a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod MountGuessContentTypeMethodInfo a signature where
    overloadedMethod = mountGuessContentType

instance O.OverloadedMethodInfo MountGuessContentTypeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGuessContentType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGuessContentType"
        })


#endif

-- method Mount::guess_content_type_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount" , 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 (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : True
-- Skip return : False

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

-- | Finishes guessing content types of /@mount@/. If any errors occurred
-- during the operation, /@error@/ will be set to contain the errors and
-- 'P.False' will be returned. In particular, you may get an
-- 'GI.Gio.Enums.IOErrorEnumNotSupported' if the mount does not support content
-- guessing.
-- 
-- /Since: 2.18/
mountGuessContentTypeFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of content types or 'P.Nothing' on error.
    --     Caller should free this array with 'GI.GLib.Functions.strfreev' when done with it. /(Can throw 'Data.GI.Base.GError.GError')/
mountGuessContentTypeFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsAsyncResult b) =>
a -> b -> m [Text]
mountGuessContentTypeFinish a
mount b
result_ = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO [Text] -> IO () -> IO [Text]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr CString
result <- (Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString))
-> (Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. (a -> b) -> a -> b
$ Ptr Mount
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr CString)
g_mount_guess_content_type_finish Ptr Mount
mount' Ptr AsyncResult
result_'
        Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mountGuessContentTypeFinish" 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
mount
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data MountGuessContentTypeFinishMethodInfo
instance (signature ~ (b -> m [T.Text]), MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod MountGuessContentTypeFinishMethodInfo a signature where
    overloadedMethod = mountGuessContentTypeFinish

instance O.OverloadedMethodInfo MountGuessContentTypeFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGuessContentTypeFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGuessContentTypeFinish"
        })


#endif

-- method Mount::guess_content_type_sync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "force_rescan"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Whether to force a rescan of the content.\n    Otherwise a cached result will be used if available"
--                 , 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
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : True
-- Skip return : False

foreign import ccall "g_mount_guess_content_type_sync" g_mount_guess_content_type_sync :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    CInt ->                                 -- force_rescan : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr CString)

-- | Tries to guess the type of content stored on /@mount@/. Returns one or
-- more textual identifiers of well-known content types (typically
-- prefixed with \"x-content\/\"), e.g. x-content\/image-dcf for camera
-- memory cards. See the
-- <http://www.freedesktop.org/wiki/Specifications/shared-mime-info-spec shared-mime-info>
-- specification for more on x-content types.
-- 
-- This is a synchronous operation and as such may block doing IO;
-- see 'GI.Gio.Interfaces.Mount.mountGuessContentType' for the asynchronous version.
-- 
-- /Since: 2.18/
mountGuessContentTypeSync ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'
    -> Bool
    -- ^ /@forceRescan@/: Whether to force a rescan of the content.
    --     Otherwise a cached result will be used if available
    -> Maybe (b)
    -- ^ /@cancellable@/: optional t'GI.Gio.Objects.Cancellable.Cancellable' object, 'P.Nothing' to ignore
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated array of content types or 'P.Nothing' on error.
    --     Caller should free this array with 'GI.GLib.Functions.strfreev' when done with it. /(Can throw 'Data.GI.Base.GError.GError')/
mountGuessContentTypeSync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsCancellable b) =>
a -> Bool -> Maybe b -> m [Text]
mountGuessContentTypeSync a
mount Bool
forceRescan Maybe b
cancellable = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    let forceRescan' :: CInt
forceRescan' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
forceRescan
    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'
    IO [Text] -> IO () -> IO [Text]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr CString
result <- (Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString))
-> (Ptr (Ptr GError) -> IO (Ptr CString)) -> IO (Ptr CString)
forall a b. (a -> b) -> a -> b
$ Ptr Mount
-> CInt -> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr CString)
g_mount_guess_content_type_sync Ptr Mount
mount' CInt
forceRescan' Ptr Cancellable
maybeCancellable
        Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"mountGuessContentTypeSync" 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
mount
        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
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data MountGuessContentTypeSyncMethodInfo
instance (signature ~ (Bool -> Maybe (b) -> m [T.Text]), MonadIO m, IsMount a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod MountGuessContentTypeSyncMethodInfo a signature where
    overloadedMethod = mountGuessContentTypeSync

instance O.OverloadedMethodInfo MountGuessContentTypeSyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountGuessContentTypeSync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountGuessContentTypeSync"
        })


#endif

-- method Mount::is_shadowed
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GMount." , 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_mount_is_shadowed" g_mount_is_shadowed :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    IO CInt

-- | Determines if /@mount@/ is shadowed. Applications or libraries should
-- avoid displaying /@mount@/ in the user interface if it is shadowed.
-- 
-- A mount is said to be shadowed if there exists one or more user
-- visible objects (currently t'GI.Gio.Interfaces.Mount.Mount' objects) with a root that is
-- inside the root of /@mount@/.
-- 
-- One application of shadow mounts is when exposing a single file
-- system that is used to address several logical volumes. In this
-- situation, a t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor' implementation would create two
-- t'GI.Gio.Interfaces.Volume.Volume' objects (for example, one for the camera functionality of
-- the device and one for a SD card reader on the device) with
-- activation URIs @gphoto2:\/\/[usb:001,002]\/store1\/@
-- and @gphoto2:\/\/[usb:001,002]\/store2\/@. When the
-- underlying mount (with root
-- @gphoto2:\/\/[usb:001,002]\/@) is mounted, said
-- t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor' implementation would create two t'GI.Gio.Interfaces.Mount.Mount' objects
-- (each with their root matching the corresponding volume activation
-- root) that would shadow the original mount.
-- 
-- The proxy monitor in GVfs 2.26 and later, automatically creates and
-- manage shadow mounts (and shadows the underlying mount) if the
-- activation root on a t'GI.Gio.Interfaces.Volume.Volume' is set.
-- 
-- /Since: 2.20/
mountIsShadowed ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: A t'GI.Gio.Interfaces.Mount.Mount'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@mount@/ is shadowed.
mountIsShadowed :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m Bool
mountIsShadowed a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    CInt
result <- Ptr Mount -> IO CInt
g_mount_is_shadowed Ptr Mount
mount'
    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
mount
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MountIsShadowedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsMount a) => O.OverloadedMethod MountIsShadowedMethodInfo a signature where
    overloadedMethod = mountIsShadowed

instance O.OverloadedMethodInfo MountIsShadowedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountIsShadowed",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountIsShadowed"
        })


#endif

-- method Mount::remount
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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\n    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_mount_remount" g_mount_remount :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    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 ()

-- | Remounts a mount. This is an asynchronous operation, and is
-- finished by calling 'GI.Gio.Interfaces.Mount.mountRemountFinish' with the /@mount@/
-- and @/GAsyncResults/@ data returned in the /@callback@/.
-- 
-- Remounting is useful when some setting affecting the operation
-- of the volume has been changed, as these may need a remount to
-- take affect. While this is semantically equivalent with unmounting
-- and then remounting not all backends might need to actually be
-- unmounted.
mountRemount ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> [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 ()
mountRemount :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsMount a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountMountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
mountRemount a
mount [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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_mount_remount Ptr Mount
mount' 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
mount
    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 MountRemountMethodInfo
instance (signature ~ ([Gio.Flags.MountMountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsMount a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod MountRemountMethodInfo a signature where
    overloadedMethod = mountRemount

instance O.OverloadedMethodInfo MountRemountMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountRemount",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountRemount"
        })


#endif

-- method Mount::remount_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_remount_finish" g_mount_remount_finish :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes remounting a mount. If any errors occurred during the operation,
-- /@error@/ will be set to contain the errors and 'P.False' will be returned.
mountRemountFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mountRemountFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsAsyncResult b) =>
a -> b -> m ()
mountRemountFinish a
mount 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_mount_remount_finish Ptr Mount
mount' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
        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 MountRemountFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod MountRemountFinishMethodInfo a signature where
    overloadedMethod = mountRemountFinish

instance O.OverloadedMethodInfo MountRemountFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountRemountFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountRemountFinish"
        })


#endif

-- method Mount::shadow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GMount." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Increments the shadow count on /@mount@/. Usually used by
-- t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor' implementations when creating a shadow mount for
-- /@mount@/, see 'GI.Gio.Interfaces.Mount.mountIsShadowed' for more information. The caller
-- will need to emit the [Mount::changed]("GI.Gio.Interfaces.Mount#g:signal:changed") signal on /@mount@/ manually.
-- 
-- /Since: 2.20/
mountShadow ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: A t'GI.Gio.Interfaces.Mount.Mount'.
    -> m ()
mountShadow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m ()
mountShadow a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr Mount -> IO ()
g_mount_shadow Ptr Mount
mount'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MountShadowMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMount a) => O.OverloadedMethod MountShadowMethodInfo a signature where
    overloadedMethod = mountShadow

instance O.OverloadedMethodInfo MountShadowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountShadow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountShadow"
        })


#endif

-- method Mount::unmount
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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 operation"
--                 , 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 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_mount_unmount" g_mount_unmount :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    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 mountUnmount ["(Since version 2.22)","Use 'GI.Gio.Interfaces.Mount.mountUnmountWithOperation' instead."] #-}
-- | Unmounts a mount. This is an asynchronous operation, and is
-- finished by calling 'GI.Gio.Interfaces.Mount.mountUnmountFinish' with the /@mount@/
-- and t'GI.Gio.Interfaces.AsyncResult.AsyncResult' data returned in the /@callback@/.
mountUnmount ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@flags@/: flags affecting the operation
    -> 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 ()
mountUnmount :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsCancellable b) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
mountUnmount a
mount [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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount
-> CUInt
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_mount_unmount Ptr Mount
mount' 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
mount
    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 MountUnmountMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsMount a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod MountUnmountMethodInfo a signature where
    overloadedMethod = mountUnmount

instance O.OverloadedMethodInfo MountUnmountMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountUnmount",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountUnmount"
        })


#endif

-- method Mount::unmount_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_unmount_finish" g_mount_unmount_finish :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

{-# DEPRECATED mountUnmountFinish ["(Since version 2.22)","Use 'GI.Gio.Interfaces.Mount.mountUnmountWithOperationFinish' instead."] #-}
-- | Finishes unmounting a mount. If any errors occurred during the operation,
-- /@error@/ will be set to contain the errors and 'P.False' will be returned.
mountUnmountFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mountUnmountFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsAsyncResult b) =>
a -> b -> m ()
mountUnmountFinish a
mount 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_mount_unmount_finish Ptr Mount
mount' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
        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 MountUnmountFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod MountUnmountFinishMethodInfo a signature where
    overloadedMethod = mountUnmountFinish

instance O.OverloadedMethodInfo MountUnmountFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountUnmountFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountUnmountFinish"
        })


#endif

-- method Mount::unmount_with_operation
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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 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\n    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_mount_unmount_with_operation" g_mount_unmount_with_operation :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    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 ()

-- | Unmounts a mount. This is an asynchronous operation, and is
-- finished by calling 'GI.Gio.Interfaces.Mount.mountUnmountWithOperationFinish' with the /@mount@/
-- and t'GI.Gio.Interfaces.AsyncResult.AsyncResult' data returned in the /@callback@/.
-- 
-- /Since: 2.22/
mountUnmountWithOperation ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> [Gio.Flags.MountUnmountFlags]
    -- ^ /@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 ()
mountUnmountWithOperation :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsMount a, IsMountOperation b,
 IsCancellable c) =>
a
-> [MountUnmountFlags]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
mountUnmountWithOperation a
mount [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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount
-> CUInt
-> Ptr MountOperation
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
g_mount_unmount_with_operation Ptr Mount
mount' 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
mount
    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 MountUnmountWithOperationMethodInfo
instance (signature ~ ([Gio.Flags.MountUnmountFlags] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsMount a, Gio.MountOperation.IsMountOperation b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod MountUnmountWithOperationMethodInfo a signature where
    overloadedMethod = mountUnmountWithOperation

instance O.OverloadedMethodInfo MountUnmountWithOperationMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountUnmountWithOperation",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountUnmountWithOperation"
        })


#endif

-- method Mount::unmount_with_operation_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMount." , 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_mount_unmount_with_operation_finish" g_mount_unmount_with_operation_finish :: 
    Ptr Mount ->                            -- mount : TInterface (Name {namespace = "Gio", name = "Mount"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finishes unmounting a mount. If any errors occurred during the operation,
-- /@error@/ will be set to contain the errors and 'P.False' will be returned.
-- 
-- /Since: 2.22/
mountUnmountWithOperationFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@mount@/: a t'GI.Gio.Interfaces.Mount.Mount'.
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
mountUnmountWithOperationFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMount a, IsAsyncResult b) =>
a -> b -> m ()
mountUnmountWithOperationFinish a
mount 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    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 Mount -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
g_mount_unmount_with_operation_finish Ptr Mount
mount' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
        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 MountUnmountWithOperationFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsMount a, Gio.AsyncResult.IsAsyncResult b) => O.OverloadedMethod MountUnmountWithOperationFinishMethodInfo a signature where
    overloadedMethod = mountUnmountWithOperationFinish

instance O.OverloadedMethodInfo MountUnmountWithOperationFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountUnmountWithOperationFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountUnmountWithOperationFinish"
        })


#endif

-- method Mount::unshadow
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount"
--           , argType = TInterface Name { namespace = "Gio" , name = "Mount" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GMount." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Decrements the shadow count on /@mount@/. Usually used by
-- t'GI.Gio.Objects.VolumeMonitor.VolumeMonitor' implementations when destroying a shadow mount for
-- /@mount@/, see 'GI.Gio.Interfaces.Mount.mountIsShadowed' for more information. The caller
-- will need to emit the [Mount::changed]("GI.Gio.Interfaces.Mount#g:signal:changed") signal on /@mount@/ manually.
-- 
-- /Since: 2.20/
mountUnshadow ::
    (B.CallStack.HasCallStack, MonadIO m, IsMount a) =>
    a
    -- ^ /@mount@/: A t'GI.Gio.Interfaces.Mount.Mount'.
    -> m ()
mountUnshadow :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMount a) =>
a -> m ()
mountUnshadow a
mount = 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 Mount
mount' <- a -> IO (Ptr Mount)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
mount
    Ptr Mount -> IO ()
g_mount_unshadow Ptr Mount
mount'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
mount
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MountUnshadowMethodInfo
instance (signature ~ (m ()), MonadIO m, IsMount a) => O.OverloadedMethod MountUnshadowMethodInfo a signature where
    overloadedMethod = mountUnshadow

instance O.OverloadedMethodInfo MountUnshadowMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount.mountUnshadow",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#v:mountUnshadow"
        })


#endif

-- signal Mount::changed
-- | Emitted when the mount has been changed.
type MountChangedCallback =
    IO ()

type C_MountChangedCallback =
    Ptr Mount ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_MountChangedCallback :: 
    GObject a => (a -> MountChangedCallback) ->
    C_MountChangedCallback
wrap_MountChangedCallback :: forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountChangedCallback a -> IO ()
gi'cb Ptr Mount
gi'selfPtr Ptr ()
_ = do
    Ptr Mount -> (Mount -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Mount
gi'selfPtr ((Mount -> IO ()) -> IO ()) -> (Mount -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Mount
gi'self -> a -> IO ()
gi'cb (Mount -> a
Coerce.coerce Mount
gi'self) 


-- | 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' mount #changed callback
-- @
-- 
-- 
onMountChanged :: (IsMount a, MonadIO m) => a -> ((?self :: a) => MountChangedCallback) -> m SignalHandlerId
onMountChanged :: forall a (m :: * -> *).
(IsMount a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMountChanged a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MountChangedCallback
wrapped' = (a -> IO ()) -> C_MountChangedCallback
forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountChangedCallback a -> IO ()
wrapped
    FunPtr C_MountChangedCallback
wrapped'' <- C_MountChangedCallback -> IO (FunPtr C_MountChangedCallback)
mk_MountChangedCallback C_MountChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_MountChangedCallback
-> 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_MountChangedCallback
wrapped'' 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' mount #changed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMountChanged :: (IsMount a, MonadIO m) => a -> ((?self :: a) => MountChangedCallback) -> m SignalHandlerId
afterMountChanged :: forall a (m :: * -> *).
(IsMount a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterMountChanged a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MountChangedCallback
wrapped' = (a -> IO ()) -> C_MountChangedCallback
forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountChangedCallback a -> IO ()
wrapped
    FunPtr C_MountChangedCallback
wrapped'' <- C_MountChangedCallback -> IO (FunPtr C_MountChangedCallback)
mk_MountChangedCallback C_MountChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_MountChangedCallback
-> 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_MountChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MountChangedSignalInfo
instance SignalInfo MountChangedSignalInfo where
    type HaskellCallbackType MountChangedSignalInfo = MountChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MountChangedCallback cb
        cb'' <- mk_MountChangedCallback cb'
        connectSignalFunPtr obj "changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount::changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#g:signal:changed"})

#endif

-- signal Mount::pre-unmount
-- | This signal may be emitted when the t'GI.Gio.Interfaces.Mount.Mount' is about to be
-- unmounted.
-- 
-- This signal depends on the backend and is only emitted if
-- GIO was used to unmount.
-- 
-- /Since: 2.22/
type MountPreUnmountCallback =
    IO ()

type C_MountPreUnmountCallback =
    Ptr Mount ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_MountPreUnmountCallback :: 
    GObject a => (a -> MountPreUnmountCallback) ->
    C_MountPreUnmountCallback
wrap_MountPreUnmountCallback :: forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountPreUnmountCallback a -> IO ()
gi'cb Ptr Mount
gi'selfPtr Ptr ()
_ = do
    Ptr Mount -> (Mount -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Mount
gi'selfPtr ((Mount -> IO ()) -> IO ()) -> (Mount -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Mount
gi'self -> a -> IO ()
gi'cb (Mount -> a
Coerce.coerce Mount
gi'self) 


-- | Connect a signal handler for the [preUnmount](#signal:preUnmount) 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' mount #preUnmount callback
-- @
-- 
-- 
onMountPreUnmount :: (IsMount a, MonadIO m) => a -> ((?self :: a) => MountPreUnmountCallback) -> m SignalHandlerId
onMountPreUnmount :: forall a (m :: * -> *).
(IsMount a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMountPreUnmount a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MountChangedCallback
wrapped' = (a -> IO ()) -> C_MountChangedCallback
forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountPreUnmountCallback a -> IO ()
wrapped
    FunPtr C_MountChangedCallback
wrapped'' <- C_MountChangedCallback -> IO (FunPtr C_MountChangedCallback)
mk_MountPreUnmountCallback C_MountChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_MountChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pre-unmount" FunPtr C_MountChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [preUnmount](#signal:preUnmount) 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' mount #preUnmount callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMountPreUnmount :: (IsMount a, MonadIO m) => a -> ((?self :: a) => MountPreUnmountCallback) -> m SignalHandlerId
afterMountPreUnmount :: forall a (m :: * -> *).
(IsMount a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterMountPreUnmount a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MountChangedCallback
wrapped' = (a -> IO ()) -> C_MountChangedCallback
forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountPreUnmountCallback a -> IO ()
wrapped
    FunPtr C_MountChangedCallback
wrapped'' <- C_MountChangedCallback -> IO (FunPtr C_MountChangedCallback)
mk_MountPreUnmountCallback C_MountChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_MountChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"pre-unmount" FunPtr C_MountChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MountPreUnmountSignalInfo
instance SignalInfo MountPreUnmountSignalInfo where
    type HaskellCallbackType MountPreUnmountSignalInfo = MountPreUnmountCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MountPreUnmountCallback cb
        cb'' <- mk_MountPreUnmountCallback cb'
        connectSignalFunPtr obj "pre-unmount" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount::pre-unmount"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#g:signal:preUnmount"})

#endif

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

type C_MountUnmountedCallback =
    Ptr Mount ->                            -- object
    Ptr () ->                               -- user_data
    IO ()

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

wrap_MountUnmountedCallback :: 
    GObject a => (a -> MountUnmountedCallback) ->
    C_MountUnmountedCallback
wrap_MountUnmountedCallback :: forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountUnmountedCallback a -> IO ()
gi'cb Ptr Mount
gi'selfPtr Ptr ()
_ = do
    Ptr Mount -> (Mount -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Mount
gi'selfPtr ((Mount -> IO ()) -> IO ()) -> (Mount -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Mount
gi'self -> a -> IO ()
gi'cb (Mount -> a
Coerce.coerce Mount
gi'self) 


-- | Connect a signal handler for the [unmounted](#signal:unmounted) 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' mount #unmounted callback
-- @
-- 
-- 
onMountUnmounted :: (IsMount a, MonadIO m) => a -> ((?self :: a) => MountUnmountedCallback) -> m SignalHandlerId
onMountUnmounted :: forall a (m :: * -> *).
(IsMount a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onMountUnmounted a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MountChangedCallback
wrapped' = (a -> IO ()) -> C_MountChangedCallback
forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountUnmountedCallback a -> IO ()
wrapped
    FunPtr C_MountChangedCallback
wrapped'' <- C_MountChangedCallback -> IO (FunPtr C_MountChangedCallback)
mk_MountUnmountedCallback C_MountChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_MountChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"unmounted" FunPtr C_MountChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [unmounted](#signal:unmounted) 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' mount #unmounted callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterMountUnmounted :: (IsMount a, MonadIO m) => a -> ((?self :: a) => MountUnmountedCallback) -> m SignalHandlerId
afterMountUnmounted :: forall a (m :: * -> *).
(IsMount a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterMountUnmounted a
obj (?self::a) => 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 wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_MountChangedCallback
wrapped' = (a -> IO ()) -> C_MountChangedCallback
forall a. GObject a => (a -> IO ()) -> C_MountChangedCallback
wrap_MountUnmountedCallback a -> IO ()
wrapped
    FunPtr C_MountChangedCallback
wrapped'' <- C_MountChangedCallback -> IO (FunPtr C_MountChangedCallback)
mk_MountUnmountedCallback C_MountChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_MountChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"unmounted" FunPtr C_MountChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data MountUnmountedSignalInfo
instance SignalInfo MountUnmountedSignalInfo where
    type HaskellCallbackType MountUnmountedSignalInfo = MountUnmountedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_MountUnmountedCallback cb
        cb'' <- mk_MountUnmountedCallback cb'
        connectSignalFunPtr obj "unmounted" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Interfaces.Mount::unmounted"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.29/docs/GI-Gio-Interfaces-Mount.html#g:signal:unmounted"})

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Mount = MountSignalList
type MountSignalList = ('[ '("changed", MountChangedSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("preUnmount", MountPreUnmountSignalInfo), '("unmounted", MountUnmountedSignalInfo)] :: [(Symbol, *)])

#endif