{-# 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.Kind as DK
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Icon as Gio.Icon

#else
import {-# SOURCE #-} qualified GI.Gio.Interfaces.Icon as Gio.Icon

#endif

-- | 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 <- Ptr GValue -> IO (Ptr UnixMountPoint)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr UnixMountPoint)
        if ptr /= FP.nullPtr
        then P.Just <$> B.ManagedPtr.newBoxed UnixMountPoint ptr
        else return P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList UnixMountPoint
type instance O.AttributeList UnixMountPoint = UnixMountPointAttributeList
type UnixMountPointAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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
    mount1' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mount1
    mount2' <- unsafeManagedPtrGetPtr mount2
    result <- g_unix_mount_point_compare mount1' mount2'
    touchManagedPtr mount1
    touchManagedPtr mount2
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_copy mountPoint'
    checkUnexpectedReturnNULL "unixMountPointCopy" result
    result' <- (wrapBoxed UnixMountPoint) result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    g_unix_mount_point_free mountPoint'
    touchManagedPtr mountPoint
    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.35/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
--           , argCallbackUserData = 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 String
unixMountPointGetDevicePath UnixMountPoint
mountPoint = IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ do
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_get_device_path mountPoint'
    checkUnexpectedReturnNULL "unixMountPointGetDevicePath" result
    result' <- cstringToString result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_get_fs_type mountPoint'
    checkUnexpectedReturnNULL "unixMountPointGetFsType" result
    result' <- cstringToText result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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 String
unixMountPointGetMountPath UnixMountPoint
mountPoint = IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ do
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_get_mount_path mountPoint'
    checkUnexpectedReturnNULL "unixMountPointGetMountPath" result
    result' <- cstringToString result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_get_options mountPoint'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_guess_can_eject mountPoint'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_guess_icon mountPoint'
    checkUnexpectedReturnNULL "unixMountPointGuessIcon" result
    result' <- (wrapObject Gio.Icon.Icon) result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_guess_name mountPoint'
    checkUnexpectedReturnNULL "unixMountPointGuessName" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_guess_symbolic_icon mountPoint'
    checkUnexpectedReturnNULL "unixMountPointGuessSymbolicIcon" result
    result' <- (wrapObject Gio.Icon.Icon) result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_is_loopback mountPoint'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_is_readonly mountPoint'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
    mountPoint' <- UnixMountPoint -> IO (Ptr UnixMountPoint)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountPoint
mountPoint
    result <- g_unix_mount_point_is_user_mountable mountPoint'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr mountPoint
    return 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.35/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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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) =>
String -> m (Maybe UnixMountPoint, Word64)
unixMountPointAt String
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
    mountPath' <- String -> IO CString
stringToCString String
mountPath
    timeRead <- allocMem :: IO (Ptr Word64)
    result <- g_unix_mount_point_at mountPath' timeRead
    maybeResult <- convertIfNonNull result $ \Ptr UnixMountPoint
result' -> do
        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'
        return result''
    timeRead' <- peek timeRead
    freeMem mountPath'
    freeMem timeRead
    return (maybeResult, timeRead')

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveUnixMountPointMethod (t :: Symbol) (o :: DK.Type) :: DK.Type 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