{-# 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 entry (e.g. @\/media\/cdrom@).
-- This corresponds roughly to a mtab entry.

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

module GI.Gio.Structs.UnixMountEntry
    ( 

-- * Exported types
    UnixMountEntry(..)                      ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveUnixMountEntryMethod             ,
#endif

-- ** at #method:at#

    unixMountEntryAt                        ,


-- ** compare #method:compare#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryCompareMethodInfo         ,
#endif
    unixMountEntryCompare                   ,


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryCopyMethodInfo            ,
#endif
    unixMountEntryCopy                      ,


-- ** for #method:for#

    unixMountEntryFor                       ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryFreeMethodInfo            ,
#endif
    unixMountEntryFree                      ,


-- ** getDevicePath #method:getDevicePath#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGetDevicePathMethodInfo   ,
#endif
    unixMountEntryGetDevicePath             ,


-- ** getFsType #method:getFsType#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGetFsTypeMethodInfo       ,
#endif
    unixMountEntryGetFsType                 ,


-- ** getMountPath #method:getMountPath#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGetMountPathMethodInfo    ,
#endif
    unixMountEntryGetMountPath              ,


-- ** getOptions #method:getOptions#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGetOptionsMethodInfo      ,
#endif
    unixMountEntryGetOptions                ,


-- ** getRootPath #method:getRootPath#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGetRootPathMethodInfo     ,
#endif
    unixMountEntryGetRootPath               ,


-- ** guessCanEject #method:guessCanEject#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGuessCanEjectMethodInfo   ,
#endif
    unixMountEntryGuessCanEject             ,


-- ** guessIcon #method:guessIcon#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGuessIconMethodInfo       ,
#endif
    unixMountEntryGuessIcon                 ,


-- ** guessName #method:guessName#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGuessNameMethodInfo       ,
#endif
    unixMountEntryGuessName                 ,


-- ** guessShouldDisplay #method:guessShouldDisplay#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGuessShouldDisplayMethodInfo,
#endif
    unixMountEntryGuessShouldDisplay        ,


-- ** guessSymbolicIcon #method:guessSymbolicIcon#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryGuessSymbolicIconMethodInfo,
#endif
    unixMountEntryGuessSymbolicIcon         ,


-- ** isReadonly #method:isReadonly#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryIsReadonlyMethodInfo      ,
#endif
    unixMountEntryIsReadonly                ,


-- ** isSystemInternal #method:isSystemInternal#

#if defined(ENABLE_OVERLOADING)
    UnixMountEntryIsSystemInternalMethodInfo,
#endif
    unixMountEntryIsSystemInternal          ,




    ) 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 UnixMountEntry = UnixMountEntry (SP.ManagedPtr UnixMountEntry)
    deriving (UnixMountEntry -> UnixMountEntry -> Bool
(UnixMountEntry -> UnixMountEntry -> Bool)
-> (UnixMountEntry -> UnixMountEntry -> Bool) -> Eq UnixMountEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnixMountEntry -> UnixMountEntry -> Bool
== :: UnixMountEntry -> UnixMountEntry -> Bool
$c/= :: UnixMountEntry -> UnixMountEntry -> Bool
/= :: UnixMountEntry -> UnixMountEntry -> Bool
Eq)

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

foreign import ccall "g_unix_mount_entry_get_type" c_g_unix_mount_entry_get_type :: 
    IO GType

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

instance B.Types.TypedObject UnixMountEntry where
    glibType :: IO GType
glibType = IO GType
c_g_unix_mount_entry_get_type

instance B.Types.GBoxed UnixMountEntry

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


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

-- method UnixMountEntry::compare
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount1"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "first [struct@GioUnix.MountEntry] to compare"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mount2"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "second [struct@GioUnix.MountEntry] to compare"
--                 , 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_entry_compare" g_unix_mount_entry_compare :: 
    Ptr UnixMountEntry ->                   -- mount1 : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    Ptr UnixMountEntry ->                   -- mount2 : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO Int32

-- | Compares two Unix mounts.
-- 
-- /Since: 2.84/
unixMountEntryCompare ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mount1@/: first @/GioUnix.MountEntry/@ to compare
    -> UnixMountEntry
    -- ^ /@mount2@/: second @/GioUnix.MountEntry/@ to compare
    -> m Int32
    -- ^ __Returns:__ @1@, @0@ or @-1@ if /@mount1@/ is greater than, equal to,
    --    or less than /@mount2@/, respectively
unixMountEntryCompare :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> UnixMountEntry -> m Int32
unixMountEntryCompare UnixMountEntry
mount1 UnixMountEntry
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' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mount1
    mount2' <- unsafeManagedPtrGetPtr mount2
    result <- g_unix_mount_entry_compare mount1' mount2'
    touchManagedPtr mount1
    touchManagedPtr mount2
    return result

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryCompareMethodInfo
instance (signature ~ (UnixMountEntry -> m Int32), MonadIO m) => O.OverloadedMethod UnixMountEntryCompareMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryCompare

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


#endif

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

foreign import ccall "g_unix_mount_entry_copy" g_unix_mount_entry_copy :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO (Ptr UnixMountEntry)

-- | Makes a copy of /@mountEntry@/.
-- 
-- /Since: 2.84/
unixMountEntryCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m UnixMountEntry
    -- ^ __Returns:__ a new @/GioUnix.MountEntry/@
unixMountEntryCopy :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m UnixMountEntry
unixMountEntryCopy UnixMountEntry
mountEntry = IO UnixMountEntry -> m UnixMountEntry
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UnixMountEntry -> m UnixMountEntry)
-> IO UnixMountEntry -> m UnixMountEntry
forall a b. (a -> b) -> a -> b
$ do
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_copy mountEntry'
    checkUnexpectedReturnNULL "unixMountEntryCopy" result
    result' <- (wrapBoxed UnixMountEntry) result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryCopyMethodInfo
instance (signature ~ (m UnixMountEntry), MonadIO m) => O.OverloadedMethod UnixMountEntryCopyMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryCopy

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


#endif

-- method UnixMountEntry::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_free" g_unix_mount_entry_free :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO ()

-- | Frees a Unix mount.
-- 
-- /Since: 2.84/
unixMountEntryFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m ()
unixMountEntryFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m ()
unixMountEntryFree UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    g_unix_mount_entry_free mountEntry'
    touchManagedPtr mountEntry
    return ()

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod UnixMountEntryFreeMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryFree

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


#endif

-- method UnixMountEntry::get_device_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_get_device_path" g_unix_mount_entry_get_device_path :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CString

-- | Gets the device path for a Unix mount.
-- 
-- /Since: 2.84/
unixMountEntryGetDevicePath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m [Char]
    -- ^ __Returns:__ a string containing the device path
unixMountEntryGetDevicePath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m String
unixMountEntryGetDevicePath UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_get_device_path mountEntry'
    checkUnexpectedReturnNULL "unixMountEntryGetDevicePath" result
    result' <- cstringToString result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGetDevicePathMethodInfo
instance (signature ~ (m [Char]), MonadIO m) => O.OverloadedMethod UnixMountEntryGetDevicePathMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGetDevicePath

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


#endif

-- method UnixMountEntry::get_fs_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_get_fs_type" g_unix_mount_entry_get_fs_type :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CString

-- | Gets the filesystem type for the Unix mount.
-- 
-- /Since: 2.84/
unixMountEntryGetFsType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m T.Text
    -- ^ __Returns:__ a string containing the file system type
unixMountEntryGetFsType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m Text
unixMountEntryGetFsType UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_get_fs_type mountEntry'
    checkUnexpectedReturnNULL "unixMountEntryGetFsType" result
    result' <- cstringToText result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGetFsTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod UnixMountEntryGetFsTypeMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGetFsType

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


#endif

-- method UnixMountEntry::get_mount_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a [struct@GioUnix.MountEntry] to get the mount path for"
--                 , 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_entry_get_mount_path" g_unix_mount_entry_get_mount_path :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CString

-- | Gets the mount path for a Unix mount.
-- 
-- /Since: 2.84/
unixMountEntryGetMountPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@ to get the mount path for
    -> m [Char]
    -- ^ __Returns:__ the mount path for /@mountEntry@/
unixMountEntryGetMountPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m String
unixMountEntryGetMountPath UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_get_mount_path mountEntry'
    checkUnexpectedReturnNULL "unixMountEntryGetMountPath" result
    result' <- cstringToString result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGetMountPathMethodInfo
instance (signature ~ (m [Char]), MonadIO m) => O.OverloadedMethod UnixMountEntryGetMountPathMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGetMountPath

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


#endif

-- method UnixMountEntry::get_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_get_options" g_unix_mount_entry_get_options :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CString

-- | Gets a comma separated list of mount options for the Unix mount.
-- 
-- For example: @rw,relatime,seclabel,data=ordered@.
-- 
-- This is similar to @/GioUnix.MountPoint.get_options()/@, but it takes
-- a @/GioUnix.MountEntry/@ as an argument.
-- 
-- /Since: 2.84/
unixMountEntryGetOptions ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string containing the options, or @NULL@ if not
    --    available.
unixMountEntryGetOptions :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m (Maybe Text)
unixMountEntryGetOptions UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_get_options mountEntry'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr mountEntry
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGetOptionsMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod UnixMountEntryGetOptionsMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGetOptions

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


#endif

-- method UnixMountEntry::get_root_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_get_root_path" g_unix_mount_entry_get_root_path :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CString

-- | Gets the root of the mount within the filesystem. This is useful e.g. for
-- mounts created by bind operation, or btrfs subvolumes.
-- 
-- For example, the root path is equal to @\/@ for a mount created by
-- @mount \/dev\/sda1 \/mnt\/foo@ and @\/bar@ for
-- @mount --bind \/mnt\/foo\/bar \/mnt\/bar@.
-- 
-- /Since: 2.84/
unixMountEntryGetRootPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ a string containing the root, or @NULL@ if not supported
unixMountEntryGetRootPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m (Maybe Text)
unixMountEntryGetRootPath UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_get_root_path mountEntry'
    maybeResult <- convertIfNonNull result $ \CString
result' -> do
        result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        return result''
    touchManagedPtr mountEntry
    return maybeResult

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGetRootPathMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod UnixMountEntryGetRootPathMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGetRootPath

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


#endif

-- method UnixMountEntry::guess_can_eject
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_guess_can_eject" g_unix_mount_entry_guess_can_eject :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CInt

-- | Guesses whether a Unix mount entry can be ejected.
-- 
-- /Since: 2.84/
unixMountEntryGuessCanEject ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m Bool
    -- ^ __Returns:__ true if /@mountEntry@/ is deemed to be ejectable; false otherwise
unixMountEntryGuessCanEject :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m Bool
unixMountEntryGuessCanEject UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_guess_can_eject mountEntry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGuessCanEjectMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod UnixMountEntryGuessCanEjectMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGuessCanEject

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


#endif

-- method UnixMountEntry::guess_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_guess_icon" g_unix_mount_entry_guess_icon :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO (Ptr Gio.Icon.Icon)

-- | Guesses the icon of a Unix mount entry.
-- 
-- /Since: 2.84/
unixMountEntryGuessIcon ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon'
unixMountEntryGuessIcon :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m Icon
unixMountEntryGuessIcon UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_guess_icon mountEntry'
    checkUnexpectedReturnNULL "unixMountEntryGuessIcon" result
    result' <- (wrapObject Gio.Icon.Icon) result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGuessIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m) => O.OverloadedMethod UnixMountEntryGuessIconMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGuessIcon

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


#endif

-- method UnixMountEntry::guess_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_guess_name" g_unix_mount_entry_guess_name :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CString

-- | Guesses the name of a Unix mount entry.
-- 
-- The result is a translated string.
-- 
-- /Since: 2.84/
unixMountEntryGuessName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m T.Text
    -- ^ __Returns:__ a newly allocated translated string
unixMountEntryGuessName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m Text
unixMountEntryGuessName UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_guess_name mountEntry'
    checkUnexpectedReturnNULL "unixMountEntryGuessName" result
    result' <- cstringToText result
    freeMem result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGuessNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod UnixMountEntryGuessNameMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGuessName

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


#endif

-- method UnixMountEntry::guess_should_display
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_guess_should_display" g_unix_mount_entry_guess_should_display :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CInt

-- | Guesses whether a Unix mount entry should be displayed in the UI.
-- 
-- /Since: 2.84/
unixMountEntryGuessShouldDisplay ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m Bool
    -- ^ __Returns:__ true if /@mountEntry@/ is deemed to be displayable; false otherwise
unixMountEntryGuessShouldDisplay :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m Bool
unixMountEntryGuessShouldDisplay UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_guess_should_display mountEntry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGuessShouldDisplayMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod UnixMountEntryGuessShouldDisplayMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGuessShouldDisplay

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


#endif

-- method UnixMountEntry::guess_symbolic_icon
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_guess_symbolic_icon" g_unix_mount_entry_guess_symbolic_icon :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO (Ptr Gio.Icon.Icon)

-- | Guesses the symbolic icon of a Unix mount entry.
-- 
-- /Since: 2.84/
unixMountEntryGuessSymbolicIcon ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m Gio.Icon.Icon
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.Icon.Icon'
unixMountEntryGuessSymbolicIcon :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m Icon
unixMountEntryGuessSymbolicIcon UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_guess_symbolic_icon mountEntry'
    checkUnexpectedReturnNULL "unixMountEntryGuessSymbolicIcon" result
    result' <- (wrapObject Gio.Icon.Icon) result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryGuessSymbolicIconMethodInfo
instance (signature ~ (m Gio.Icon.Icon), MonadIO m) => O.OverloadedMethod UnixMountEntryGuessSymbolicIconMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryGuessSymbolicIcon

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


#endif

-- method UnixMountEntry::is_readonly
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_is_readonly" g_unix_mount_entry_is_readonly :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CInt

-- | Checks if a Unix mount is mounted read only.
-- 
-- /Since: 2.84/
unixMountEntryIsReadonly ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m Bool
    -- ^ __Returns:__ true if /@mountEntry@/ is read only; false otherwise
unixMountEntryIsReadonly :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m Bool
unixMountEntryIsReadonly UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_is_readonly mountEntry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryIsReadonlyMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod UnixMountEntryIsReadonlyMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryIsReadonly

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


#endif

-- method UnixMountEntry::is_system_internal
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "mount_entry"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "UnixMountEntry" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a [struct@GioUnix.MountEntry]"
--                 , 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_entry_is_system_internal" g_unix_mount_entry_is_system_internal :: 
    Ptr UnixMountEntry ->                   -- mount_entry : TInterface (Name {namespace = "Gio", name = "UnixMountEntry"})
    IO CInt

-- | Checks if a Unix mount is a system mount.
-- 
-- This is the Boolean OR of
-- @/GioUnix.is_system_fs_type/@, @/GioUnix.is_system_device_path/@ and
-- @/GioUnix.is_mount_path_system_internal/@ on /@mountEntry@/’s properties.
-- 
-- The definition of what a ‘system’ mount entry is may change over time as new
-- file system types and device paths are ignored.
-- 
-- /Since: 2.84/
unixMountEntryIsSystemInternal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    UnixMountEntry
    -- ^ /@mountEntry@/: a @/GioUnix.MountEntry/@
    -> m Bool
    -- ^ __Returns:__ true if the Unix mount is for a system path; false otherwise
unixMountEntryIsSystemInternal :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
UnixMountEntry -> m Bool
unixMountEntryIsSystemInternal UnixMountEntry
mountEntry = 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
    mountEntry' <- UnixMountEntry -> IO (Ptr UnixMountEntry)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr UnixMountEntry
mountEntry
    result <- g_unix_mount_entry_is_system_internal mountEntry'
    let result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    touchManagedPtr mountEntry
    return result'

#if defined(ENABLE_OVERLOADING)
data UnixMountEntryIsSystemInternalMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod UnixMountEntryIsSystemInternalMethodInfo UnixMountEntry signature where
    overloadedMethod = unixMountEntryIsSystemInternal

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


#endif

-- method UnixMountEntry::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"
--                 , 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 "return location for a timestamp"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "UnixMountEntry" })
-- throws : False
-- Skip return : False

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

-- | Gets a @/GioUnix.MountEntry/@ for a given mount path.
-- 
-- If /@timeRead@/ is set, it will be filled with a Unix timestamp for checking
-- if the mounts have changed since with
-- @/GioUnix.mount_entries_changed_since/@.
-- 
-- If more mounts have the same mount path, the last matching mount
-- is returned.
-- 
-- This will return @NULL@ if there is no mount point at /@mountPath@/.
-- 
-- /Since: 2.84/
unixMountEntryAt ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@mountPath@/: path for a possible Unix mount
    -> m ((Maybe UnixMountEntry, Word64))
    -- ^ __Returns:__ a @/GioUnix.MountEntry/@
unixMountEntryAt :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m (Maybe UnixMountEntry, Word64)
unixMountEntryAt String
mountPath = IO (Maybe UnixMountEntry, Word64)
-> m (Maybe UnixMountEntry, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UnixMountEntry, Word64)
 -> m (Maybe UnixMountEntry, Word64))
-> IO (Maybe UnixMountEntry, Word64)
-> m (Maybe UnixMountEntry, 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_entry_at mountPath' timeRead
    maybeResult <- convertIfNonNull result $ \Ptr UnixMountEntry
result' -> do
        result'' <- ((ManagedPtr UnixMountEntry -> UnixMountEntry)
-> Ptr UnixMountEntry -> IO UnixMountEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UnixMountEntry -> UnixMountEntry
UnixMountEntry) Ptr UnixMountEntry
result'
        return result''
    timeRead' <- peek timeRead
    freeMem mountPath'
    freeMem timeRead
    return (maybeResult, timeRead')

#if defined(ENABLE_OVERLOADING)
#endif

-- method UnixMountEntry::for
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "file_path"
--           , argType = TBasicType TFileName
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "file path on some Unix mount"
--                 , 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 "return location for a timestamp"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Gio" , name = "UnixMountEntry" })
-- throws : False
-- Skip return : False

foreign import ccall "g_unix_mount_entry_for" g_unix_mount_entry_for :: 
    CString ->                              -- file_path : TBasicType TFileName
    Ptr Word64 ->                           -- time_read : TBasicType TUInt64
    IO (Ptr UnixMountEntry)

-- | Gets a @/GioUnix.MountEntry/@ for a given file path.
-- 
-- If /@timeRead@/ is set, it will be filled with a Unix timestamp for checking
-- if the mounts have changed since with
-- @/GioUnix.mount_entries_changed_since/@.
-- 
-- If more mounts have the same mount path, the last matching mount
-- is returned.
-- 
-- This will return @NULL@ if looking up the mount entry fails, if
-- /@filePath@/ doesn’t exist or there is an I\/O error.
-- 
-- /Since: 2.84/
unixMountEntryFor ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    [Char]
    -- ^ /@filePath@/: file path on some Unix mount
    -> m ((Maybe UnixMountEntry, Word64))
    -- ^ __Returns:__ a @/GioUnix.MountEntry/@
unixMountEntryFor :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m (Maybe UnixMountEntry, Word64)
unixMountEntryFor String
filePath = IO (Maybe UnixMountEntry, Word64)
-> m (Maybe UnixMountEntry, Word64)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe UnixMountEntry, Word64)
 -> m (Maybe UnixMountEntry, Word64))
-> IO (Maybe UnixMountEntry, Word64)
-> m (Maybe UnixMountEntry, Word64)
forall a b. (a -> b) -> a -> b
$ do
    filePath' <- String -> IO CString
stringToCString String
filePath
    timeRead <- allocMem :: IO (Ptr Word64)
    result <- g_unix_mount_entry_for filePath' timeRead
    maybeResult <- convertIfNonNull result $ \Ptr UnixMountEntry
result' -> do
        result'' <- ((ManagedPtr UnixMountEntry -> UnixMountEntry)
-> Ptr UnixMountEntry -> IO UnixMountEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr UnixMountEntry -> UnixMountEntry
UnixMountEntry) Ptr UnixMountEntry
result'
        return result''
    timeRead' <- peek timeRead
    freeMem filePath'
    freeMem timeRead
    return (maybeResult, timeRead')

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveUnixMountEntryMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveUnixMountEntryMethod "compare" o = UnixMountEntryCompareMethodInfo
    ResolveUnixMountEntryMethod "copy" o = UnixMountEntryCopyMethodInfo
    ResolveUnixMountEntryMethod "free" o = UnixMountEntryFreeMethodInfo
    ResolveUnixMountEntryMethod "guessCanEject" o = UnixMountEntryGuessCanEjectMethodInfo
    ResolveUnixMountEntryMethod "guessIcon" o = UnixMountEntryGuessIconMethodInfo
    ResolveUnixMountEntryMethod "guessName" o = UnixMountEntryGuessNameMethodInfo
    ResolveUnixMountEntryMethod "guessShouldDisplay" o = UnixMountEntryGuessShouldDisplayMethodInfo
    ResolveUnixMountEntryMethod "guessSymbolicIcon" o = UnixMountEntryGuessSymbolicIconMethodInfo
    ResolveUnixMountEntryMethod "isReadonly" o = UnixMountEntryIsReadonlyMethodInfo
    ResolveUnixMountEntryMethod "isSystemInternal" o = UnixMountEntryIsSystemInternalMethodInfo
    ResolveUnixMountEntryMethod "getDevicePath" o = UnixMountEntryGetDevicePathMethodInfo
    ResolveUnixMountEntryMethod "getFsType" o = UnixMountEntryGetFsTypeMethodInfo
    ResolveUnixMountEntryMethod "getMountPath" o = UnixMountEntryGetMountPathMethodInfo
    ResolveUnixMountEntryMethod "getOptions" o = UnixMountEntryGetOptionsMethodInfo
    ResolveUnixMountEntryMethod "getRootPath" o = UnixMountEntryGetRootPathMethodInfo
    ResolveUnixMountEntryMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif