{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Defines a Unix mount point (e.g. \<filename>\/dev\<\/filename>).
-- This corresponds roughly to a fstab entry.

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

module GI.Gio.Structs.UnixMountPoint
    ( 

-- * Exported types
    UnixMountPoint(..)                      ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [compare]("GI.Gio.Structs.UnixMountPoint#g:method:compare"), [copy]("GI.Gio.Structs.UnixMountPoint#g:method:copy"), [free]("GI.Gio.Structs.UnixMountPoint#g:method:free"), [guessCanEject]("GI.Gio.Structs.UnixMountPoint#g:method:guessCanEject"), [guessIcon]("GI.Gio.Structs.UnixMountPoint#g:method:guessIcon"), [guessName]("GI.Gio.Structs.UnixMountPoint#g:method:guessName"), [guessSymbolicIcon]("GI.Gio.Structs.UnixMountPoint#g:method:guessSymbolicIcon"), [isLoopback]("GI.Gio.Structs.UnixMountPoint#g:method:isLoopback"), [isReadonly]("GI.Gio.Structs.UnixMountPoint#g:method:isReadonly"), [isUserMountable]("GI.Gio.Structs.UnixMountPoint#g:method:isUserMountable").
-- 
-- ==== Getters
-- [getDevicePath]("GI.Gio.Structs.UnixMountPoint#g:method:getDevicePath"), [getFsType]("GI.Gio.Structs.UnixMountPoint#g:method:getFsType"), [getMountPath]("GI.Gio.Structs.UnixMountPoint#g:method:getMountPath"), [getOptions]("GI.Gio.Structs.UnixMountPoint#g:method:getOptions").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveUnixMountPointMethod             ,
#endif

-- ** at #method:at#

    unixMountPointAt                        ,


-- ** compare #method:compare#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointCompareMethodInfo         ,
#endif
    unixMountPointCompare                   ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointCopyMethodInfo            ,
#endif
    unixMountPointCopy                      ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointFreeMethodInfo            ,
#endif
    unixMountPointFree                      ,


-- ** getDevicePath #method:getDevicePath#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointGetDevicePathMethodInfo   ,
#endif
    unixMountPointGetDevicePath             ,


-- ** getFsType #method:getFsType#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointGetFsTypeMethodInfo       ,
#endif
    unixMountPointGetFsType                 ,


-- ** getMountPath #method:getMountPath#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointGetMountPathMethodInfo    ,
#endif
    unixMountPointGetMountPath              ,


-- ** getOptions #method:getOptions#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointGetOptionsMethodInfo      ,
#endif
    unixMountPointGetOptions                ,


-- ** guessCanEject #method:guessCanEject#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointGuessCanEjectMethodInfo   ,
#endif
    unixMountPointGuessCanEject             ,


-- ** guessIcon #method:guessIcon#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointGuessIconMethodInfo       ,
#endif
    unixMountPointGuessIcon                 ,


-- ** guessName #method:guessName#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointGuessNameMethodInfo       ,
#endif
    unixMountPointGuessName                 ,


-- ** guessSymbolicIcon #method:guessSymbolicIcon#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointGuessSymbolicIconMethodInfo,
#endif
    unixMountPointGuessSymbolicIcon         ,


-- ** isLoopback #method:isLoopback#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointIsLoopbackMethodInfo      ,
#endif
    unixMountPointIsLoopback                ,


-- ** isReadonly #method:isReadonly#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointIsReadonlyMethodInfo      ,
#endif
    unixMountPointIsReadonly                ,


-- ** isUserMountable #method:isUserMountable#

#if defined(ENABLE_OVERLOADING)
    UnixMountPointIsUserMountableMethodInfo ,
#endif
    unixMountPointIsUserMountable           ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.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 {-# SOURCE #-} qualified GI.Gio.Interfaces.Icon as Gio.Icon

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

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

foreign import ccall "g_unix_mount_point_get_type" c_g_unix_mount_point_get_type :: 
    IO GType

type instance O.ParentTypes UnixMountPoint = '[]
instance O.HasParentTypes UnixMountPoint

instance B.Types.TypedObject UnixMountPoint where
    glibType :: IO GType
glibType = IO GType
c_g_unix_mount_point_get_type

instance B.Types.GBoxed UnixMountPoint

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


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

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

foreign import ccall "g_unix_mount_point_compare" g_unix_mount_point_compare :: 
    Ptr UnixMountPoint ->                   -- mount1 : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    Ptr UnixMountPoint ->                   -- mount2 : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO Int32

-- | Compares two unix mount points.
unixMountPointCompare ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mount1@/: a @/GUnixMount/@.
    -> UnixMountPoint
    -- ^ /@mount2@/: a @/GUnixMount/@.
    -> m Int32
    -- ^ __Returns:__ 1, 0 or -1 if /@mount1@/ is greater than, equal to,
    -- or less than /@mount2@/, respectively.
unixMountPointCompare :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> UnixMountPoint -> m Int32
unixMountPointCompare UnixMountPoint
mount1 UnixMountPoint
mount2 = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mount1' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mount1
    Ptr UnixMountPoint
mount2' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mount2
    Int32
result <- Ptr UnixMountPoint -> Ptr UnixMountPoint -> IO Int32
g_unix_mount_point_compare Ptr UnixMountPoint
mount1' Ptr UnixMountPoint
mount2'
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mount1
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mount2
    Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data UnixMountPointCompareMethodInfo
instance (signature ~ (UnixMountPoint -> m Int32), MonadIO m) => O.OverloadedMethod UnixMountPointCompareMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointCompare

instance O.OverloadedMethodInfo UnixMountPointCompareMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointCompare",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointCompare"
        })


#endif

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

foreign import ccall "g_unix_mount_point_copy" g_unix_mount_point_copy :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO (Ptr UnixMountPoint)

-- | Makes a copy of /@mountPoint@/.
-- 
-- /Since: 2.54/
unixMountPointCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'.
    -> m UnixMountPoint
    -- ^ __Returns:__ a new t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'
unixMountPointCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m UnixMountPoint
unixMountPointCopy UnixMountPoint
mountPoint = IO UnixMountPoint -> m UnixMountPoint
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnixMountPoint -> m UnixMountPoint)
-> IO UnixMountPoint -> m UnixMountPoint
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    Ptr UnixMountPoint
result <- Ptr UnixMountPoint -> IO (Ptr UnixMountPoint)
g_unix_mount_point_copy Ptr UnixMountPoint
mountPoint'
    Text -> Ptr UnixMountPoint -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixMountPointCopy" Ptr UnixMountPoint
result
    UnixMountPoint
result' <- ((ManagedPtr UnixMountPoint -> UnixMountPoint)
-> Ptr UnixMountPoint -> IO UnixMountPoint
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UnixMountPoint -> UnixMountPoint
UnixMountPoint) Ptr UnixMountPoint
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    UnixMountPoint -> IO UnixMountPoint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnixMountPoint
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointCopyMethodInfo
instance (signature ~ (m UnixMountPoint), MonadIO m) => O.OverloadedMethod UnixMountPointCopyMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointCopy

instance O.OverloadedMethodInfo UnixMountPointCopyMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointCopy",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointCopy"
        })


#endif

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

foreign import ccall "g_unix_mount_point_free" g_unix_mount_point_free :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO ()

-- | Frees a unix mount point.
unixMountPointFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: unix mount point to free.
    -> m ()
unixMountPointFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m ()
unixMountPointFree UnixMountPoint
mountPoint = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    Ptr UnixMountPoint -> IO ()
g_unix_mount_point_free Ptr UnixMountPoint
mountPoint'
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data UnixMountPointFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod UnixMountPointFreeMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointFree

instance O.OverloadedMethodInfo UnixMountPointFreeMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointFree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointFree"
        })


#endif

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

foreign import ccall "g_unix_mount_point_get_device_path" g_unix_mount_point_get_device_path :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CString

-- | Gets the device path for a unix mount point.
unixMountPointGetDevicePath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'.
    -> m [Char]
    -- ^ __Returns:__ a string containing the device path.
unixMountPointGetDevicePath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m [Char]
unixMountPointGetDevicePath UnixMountPoint
mountPoint = IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CString
result <- Ptr UnixMountPoint -> IO CString
g_unix_mount_point_get_device_path Ptr UnixMountPoint
mountPoint'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixMountPointGetDevicePath" CString
result
    [Char]
result' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointGetDevicePathMethodInfo
instance (signature ~ (m [Char]), MonadIO m) => O.OverloadedMethod UnixMountPointGetDevicePathMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointGetDevicePath

instance O.OverloadedMethodInfo UnixMountPointGetDevicePathMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointGetDevicePath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointGetDevicePath"
        })


#endif

-- method UnixMountPoint::get_fs_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint."
--                 , 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_unix_mount_point_get_fs_type" g_unix_mount_point_get_fs_type :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CString

-- | Gets the file system type for the mount point.
unixMountPointGetFsType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'.
    -> m T.Text
    -- ^ __Returns:__ a string containing the file system type.
unixMountPointGetFsType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m Text
unixMountPointGetFsType UnixMountPoint
mountPoint = IO Text -> m Text
forall a. IO a -> m a
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 UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CString
result <- Ptr UnixMountPoint -> IO CString
g_unix_mount_point_get_fs_type Ptr UnixMountPoint
mountPoint'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixMountPointGetFsType" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointGetFsTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod UnixMountPointGetFsTypeMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointGetFsType

instance O.OverloadedMethodInfo UnixMountPointGetFsTypeMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointGetFsType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointGetFsType"
        })


#endif

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

foreign import ccall "g_unix_mount_point_get_mount_path" g_unix_mount_point_get_mount_path :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CString

-- | Gets the mount path for a unix mount point.
unixMountPointGetMountPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'.
    -> m [Char]
    -- ^ __Returns:__ a string containing the mount path.
unixMountPointGetMountPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m [Char]
unixMountPointGetMountPath UnixMountPoint
mountPoint = IO [Char] -> m [Char]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> m [Char]) -> IO [Char] -> m [Char]
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CString
result <- Ptr UnixMountPoint -> IO CString
g_unix_mount_point_get_mount_path Ptr UnixMountPoint
mountPoint'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixMountPointGetMountPath" CString
result
    [Char]
result' <- HasCallStack => CString -> IO [Char]
CString -> IO [Char]
cstringToString CString
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointGetMountPathMethodInfo
instance (signature ~ (m [Char]), MonadIO m) => O.OverloadedMethod UnixMountPointGetMountPathMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointGetMountPath

instance O.OverloadedMethodInfo UnixMountPointGetMountPathMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointGetMountPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointGetMountPath"
        })


#endif

-- method UnixMountPoint::get_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint."
--                 , 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_unix_mount_point_get_options" g_unix_mount_point_get_options :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CString

-- | Gets the options for the mount point.
-- 
-- /Since: 2.32/
unixMountPointGetOptions ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string containing the options.
unixMountPointGetOptions :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m (Maybe Text)
unixMountPointGetOptions UnixMountPoint
mountPoint = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
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 UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CString
result <- Ptr UnixMountPoint -> IO CString
g_unix_mount_point_get_options Ptr UnixMountPoint
mountPoint'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data UnixMountPointGetOptionsMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod UnixMountPointGetOptionsMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointGetOptions

instance O.OverloadedMethodInfo UnixMountPointGetOptionsMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointGetOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointGetOptions"
        })


#endif

-- method UnixMountPoint::guess_can_eject
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint" , 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_unix_mount_point_guess_can_eject" g_unix_mount_point_guess_can_eject :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CInt

-- | Guesses whether a Unix mount point can be ejected.
unixMountPointGuessCanEject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@mountPoint@/ is deemed to be ejectable.
unixMountPointGuessCanEject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m Bool
unixMountPointGuessCanEject UnixMountPoint
mountPoint = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CInt
result <- Ptr UnixMountPoint -> IO CInt
g_unix_mount_point_guess_can_eject Ptr UnixMountPoint
mountPoint'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointGuessCanEjectMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod UnixMountPointGuessCanEjectMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointGuessCanEject

instance O.OverloadedMethodInfo UnixMountPointGuessCanEjectMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointGuessCanEject",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointGuessCanEject"
        })


#endif

-- method UnixMountPoint::guess_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint" , 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_unix_mount_point_guess_icon" g_unix_mount_point_guess_icon :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO (Ptr Gio.Icon.Icon)

-- | Guesses the icon of a Unix mount point.
unixMountPointGuessIcon ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon'
unixMountPointGuessIcon :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m Icon
unixMountPointGuessIcon UnixMountPoint
mountPoint = IO Icon -> m Icon
forall a. IO a -> m a
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 UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    Ptr Icon
result <- Ptr UnixMountPoint -> IO (Ptr Icon)
g_unix_mount_point_guess_icon Ptr UnixMountPoint
mountPoint'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixMountPointGuessIcon" 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
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Icon -> IO Icon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointGuessIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m) => O.OverloadedMethod UnixMountPointGuessIconMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointGuessIcon

instance O.OverloadedMethodInfo UnixMountPointGuessIconMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointGuessIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointGuessIcon"
        })


#endif

-- method UnixMountPoint::guess_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint" , 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_unix_mount_point_guess_name" g_unix_mount_point_guess_name :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CString

-- | Guesses the name of a Unix mount point.
-- The result is a translated string.
unixMountPointGuessName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'
    -> m T.Text
    -- ^ __Returns:__ A newly allocated string that must
    --     be freed with 'GI.GLib.Functions.free'
unixMountPointGuessName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m Text
unixMountPointGuessName UnixMountPoint
mountPoint = IO Text -> m Text
forall a. IO a -> m a
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 UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CString
result <- Ptr UnixMountPoint -> IO CString
g_unix_mount_point_guess_name Ptr UnixMountPoint
mountPoint'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixMountPointGuessName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointGuessNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod UnixMountPointGuessNameMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointGuessName

instance O.OverloadedMethodInfo UnixMountPointGuessNameMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointGuessName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointGuessName"
        })


#endif

-- method UnixMountPoint::guess_symbolic_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint" , 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_unix_mount_point_guess_symbolic_icon" g_unix_mount_point_guess_symbolic_icon :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO (Ptr Gio.Icon.Icon)

-- | Guesses the symbolic icon of a Unix mount point.
-- 
-- /Since: 2.34/
unixMountPointGuessSymbolicIcon ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon'
unixMountPointGuessSymbolicIcon :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m Icon
unixMountPointGuessSymbolicIcon UnixMountPoint
mountPoint = IO Icon -> m Icon
forall a. IO a -> m a
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 UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    Ptr Icon
result <- Ptr UnixMountPoint -> IO (Ptr Icon)
g_unix_mount_point_guess_symbolic_icon Ptr UnixMountPoint
mountPoint'
    Text -> Ptr Icon -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"unixMountPointGuessSymbolicIcon" 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
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Icon -> IO Icon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Icon
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointGuessSymbolicIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m) => O.OverloadedMethod UnixMountPointGuessSymbolicIconMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointGuessSymbolicIcon

instance O.OverloadedMethodInfo UnixMountPointGuessSymbolicIconMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointGuessSymbolicIcon",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointGuessSymbolicIcon"
        })


#endif

-- method UnixMountPoint::is_loopback
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint."
--                 , 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_unix_mount_point_is_loopback" g_unix_mount_point_is_loopback :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CInt

-- | Checks if a unix mount point is a loopback device.
unixMountPointIsLoopback ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the mount point is a loopback. 'P.False' otherwise.
unixMountPointIsLoopback :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m Bool
unixMountPointIsLoopback UnixMountPoint
mountPoint = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CInt
result <- Ptr UnixMountPoint -> IO CInt
g_unix_mount_point_is_loopback Ptr UnixMountPoint
mountPoint'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointIsLoopbackMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod UnixMountPointIsLoopbackMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointIsLoopback

instance O.OverloadedMethodInfo UnixMountPointIsLoopbackMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointIsLoopback",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointIsLoopback"
        })


#endif

-- method UnixMountPoint::is_readonly
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint."
--                 , 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_unix_mount_point_is_readonly" g_unix_mount_point_is_readonly :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CInt

-- | Checks if a unix mount point is read only.
unixMountPointIsReadonly ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if a mount point is read only.
unixMountPointIsReadonly :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m Bool
unixMountPointIsReadonly UnixMountPoint
mountPoint = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CInt
result <- Ptr UnixMountPoint -> IO CInt
g_unix_mount_point_is_readonly Ptr UnixMountPoint
mountPoint'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointIsReadonlyMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod UnixMountPointIsReadonlyMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointIsReadonly

instance O.OverloadedMethodInfo UnixMountPointIsReadonlyMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointIsReadonly",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointIsReadonly"
        })


#endif

-- method UnixMountPoint::is_user_mountable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_point"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountPoint" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GUnixMountPoint."
--                 , 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_unix_mount_point_is_user_mountable" g_unix_mount_point_is_user_mountable :: 
    Ptr UnixMountPoint ->                   -- mount_point : TInterface (Name {namespace = "Gio", name = "UnixMountPoint"})
    IO CInt

-- | Checks if a unix mount point is mountable by the user.
unixMountPointIsUserMountable ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountPoint
    -- ^ /@mountPoint@/: a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the mount point is user mountable.
unixMountPointIsUserMountable :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountPoint -> m Bool
unixMountPointIsUserMountable UnixMountPoint
mountPoint = IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr UnixMountPoint
mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    CInt
result <- Ptr UnixMountPoint -> IO CInt
g_unix_mount_point_is_user_mountable Ptr UnixMountPoint
mountPoint'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    UnixMountPoint -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr UnixMountPoint
mountPoint
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data UnixMountPointIsUserMountableMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod UnixMountPointIsUserMountableMethodInfo UnixMountPoint signature where
    overloadedMethod = unixMountPointIsUserMountable

instance O.OverloadedMethodInfo UnixMountPointIsUserMountableMethodInfo UnixMountPoint where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Structs.UnixMountPoint.unixMountPointIsUserMountable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.30/docs/GI-Gio-Structs-UnixMountPoint.html#v:unixMountPointIsUserMountable"
        })


#endif

-- method UnixMountPoint::at
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "mount_path"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "path for a possible unix mount point."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time_read"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "guint64 to contain a timestamp."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "UnixMountPoint" })
-- throws : False
-- Skip return : False

foreign import ccall "g_unix_mount_point_at" g_unix_mount_point_at :: 
    CString ->                              -- mount_path : TBasicType TFileName
    Ptr Word64 ->                           -- time_read : TBasicType TUInt64
    IO (Ptr UnixMountPoint)

-- | Gets a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint' for a given mount path. If /@timeRead@/ is set, it
-- will be filled with a unix timestamp for checking if the mount points have
-- changed since with 'GI.Gio.Functions.unixMountPointsChangedSince'.
-- 
-- If more mount points have the same mount path, the last matching mount point
-- is returned.
-- 
-- /Since: 2.66/
unixMountPointAt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@mountPath@/: path for a possible unix mount point.
    -> m ((Maybe UnixMountPoint, Word64))
    -- ^ __Returns:__ a t'GI.Gio.Structs.UnixMountPoint.UnixMountPoint', or 'P.Nothing' if no match
    -- is found.
unixMountPointAt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[Char] -> m (Maybe UnixMountPoint, Word64)
unixMountPointAt [Char]
mountPath = IO (Maybe UnixMountPoint, Word64)
-> m (Maybe UnixMountPoint, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UnixMountPoint, Word64)
 -> m (Maybe UnixMountPoint, Word64))
-> IO (Maybe UnixMountPoint, Word64)
-> m (Maybe UnixMountPoint, Word64)
forall a b. (a -> b) -> a -> b
$ do
    CString
mountPath' <- [Char] -> IO CString
stringToCString [Char]
mountPath
    Ptr Word64
timeRead <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr UnixMountPoint
result <- CString -> Ptr Word64 -> IO (Ptr UnixMountPoint)
g_unix_mount_point_at CString
mountPath' Ptr Word64
timeRead
    Maybe UnixMountPoint
maybeResult <- Ptr UnixMountPoint
-> (Ptr UnixMountPoint -> IO UnixMountPoint)
-> IO (Maybe UnixMountPoint)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr UnixMountPoint
result ((Ptr UnixMountPoint -> IO UnixMountPoint)
 -> IO (Maybe UnixMountPoint))
-> (Ptr UnixMountPoint -> IO UnixMountPoint)
-> IO (Maybe UnixMountPoint)
forall a b. (a -> b) -> a -> b
$ \Ptr UnixMountPoint
result' -> do
        UnixMountPoint
result'' <- ((ManagedPtr UnixMountPoint -> UnixMountPoint)
-> Ptr UnixMountPoint -> IO UnixMountPoint
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UnixMountPoint -> UnixMountPoint
UnixMountPoint) Ptr UnixMountPoint
result'
        UnixMountPoint -> IO UnixMountPoint
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnixMountPoint
result''
    Word64
timeRead' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
timeRead
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mountPath'
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
timeRead
    (Maybe UnixMountPoint, Word64) -> IO (Maybe UnixMountPoint, Word64)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe UnixMountPoint
maybeResult, Word64
timeRead')

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveUnixMountPointMethod (t :: Symbol) (o :: *) :: * where
    ResolveUnixMountPointMethod "compare" o = UnixMountPointCompareMethodInfo
    ResolveUnixMountPointMethod "copy" o = UnixMountPointCopyMethodInfo
    ResolveUnixMountPointMethod "free" o = UnixMountPointFreeMethodInfo
    ResolveUnixMountPointMethod "guessCanEject" o = UnixMountPointGuessCanEjectMethodInfo
    ResolveUnixMountPointMethod "guessIcon" o = UnixMountPointGuessIconMethodInfo
    ResolveUnixMountPointMethod "guessName" o = UnixMountPointGuessNameMethodInfo
    ResolveUnixMountPointMethod "guessSymbolicIcon" o = UnixMountPointGuessSymbolicIconMethodInfo
    ResolveUnixMountPointMethod "isLoopback" o = UnixMountPointIsLoopbackMethodInfo
    ResolveUnixMountPointMethod "isReadonly" o = UnixMountPointIsReadonlyMethodInfo
    ResolveUnixMountPointMethod "isUserMountable" o = UnixMountPointIsUserMountableMethodInfo
    ResolveUnixMountPointMethod "getDevicePath" o = UnixMountPointGetDevicePathMethodInfo
    ResolveUnixMountPointMethod "getFsType" o = UnixMountPointGetFsTypeMethodInfo
    ResolveUnixMountPointMethod "getMountPath" o = UnixMountPointGetMountPathMethodInfo
    ResolveUnixMountPointMethod "getOptions" o = UnixMountPointGetOptionsMethodInfo
    ResolveUnixMountPointMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif