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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.OSTree.Objects.Sysroot
    ( 
#if defined(ENABLE_OVERLOADING)
    SysrootLoadIfChangedMethodInfo          ,
#endif

-- * Exported types
    Sysroot(..)                             ,
    IsSysroot                               ,
    toSysroot                               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [cleanup]("GI.OSTree.Objects.Sysroot#g:method:cleanup"), [cleanupPruneRepo]("GI.OSTree.Objects.Sysroot#g:method:cleanupPruneRepo"), [deployTree]("GI.OSTree.Objects.Sysroot#g:method:deployTree"), [deployTreeWithOptions]("GI.OSTree.Objects.Sysroot#g:method:deployTreeWithOptions"), [deploymentSetKargs]("GI.OSTree.Objects.Sysroot#g:method:deploymentSetKargs"), [deploymentSetMutable]("GI.OSTree.Objects.Sysroot#g:method:deploymentSetMutable"), [deploymentSetPinned]("GI.OSTree.Objects.Sysroot#g:method:deploymentSetPinned"), [deploymentUnlock]("GI.OSTree.Objects.Sysroot#g:method:deploymentUnlock"), [ensureInitialized]("GI.OSTree.Objects.Sysroot#g:method:ensureInitialized"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [initOsname]("GI.OSTree.Objects.Sysroot#g:method:initOsname"), [initialize]("GI.OSTree.Objects.Sysroot#g:method:initialize"), [isBooted]("GI.OSTree.Objects.Sysroot#g:method:isBooted"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [load]("GI.OSTree.Objects.Sysroot#g:method:load"), [loadIfChanged]("GI.OSTree.Objects.Sysroot#g:method:loadIfChanged"), [lock]("GI.OSTree.Objects.Sysroot#g:method:lock"), [lockAsync]("GI.OSTree.Objects.Sysroot#g:method:lockAsync"), [lockFinish]("GI.OSTree.Objects.Sysroot#g:method:lockFinish"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [originNewFromRefspec]("GI.OSTree.Objects.Sysroot#g:method:originNewFromRefspec"), [prepareCleanup]("GI.OSTree.Objects.Sysroot#g:method:prepareCleanup"), [queryDeploymentsFor]("GI.OSTree.Objects.Sysroot#g:method:queryDeploymentsFor"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [repo]("GI.OSTree.Objects.Sysroot#g:method:repo"), [requireBootedDeployment]("GI.OSTree.Objects.Sysroot#g:method:requireBootedDeployment"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [simpleWriteDeployment]("GI.OSTree.Objects.Sysroot#g:method:simpleWriteDeployment"), [stageOverlayInitrd]("GI.OSTree.Objects.Sysroot#g:method:stageOverlayInitrd"), [stageTree]("GI.OSTree.Objects.Sysroot#g:method:stageTree"), [stageTreeWithOptions]("GI.OSTree.Objects.Sysroot#g:method:stageTreeWithOptions"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [tryLock]("GI.OSTree.Objects.Sysroot#g:method:tryLock"), [unload]("GI.OSTree.Objects.Sysroot#g:method:unload"), [unlock]("GI.OSTree.Objects.Sysroot#g:method:unlock"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure"), [writeDeployments]("GI.OSTree.Objects.Sysroot#g:method:writeDeployments"), [writeDeploymentsWithOptions]("GI.OSTree.Objects.Sysroot#g:method:writeDeploymentsWithOptions"), [writeOriginFile]("GI.OSTree.Objects.Sysroot#g:method:writeOriginFile").
-- 
-- ==== Getters
-- [getBootedDeployment]("GI.OSTree.Objects.Sysroot#g:method:getBootedDeployment"), [getBootversion]("GI.OSTree.Objects.Sysroot#g:method:getBootversion"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getDeploymentDirectory]("GI.OSTree.Objects.Sysroot#g:method:getDeploymentDirectory"), [getDeploymentDirpath]("GI.OSTree.Objects.Sysroot#g:method:getDeploymentDirpath"), [getDeployments]("GI.OSTree.Objects.Sysroot#g:method:getDeployments"), [getFd]("GI.OSTree.Objects.Sysroot#g:method:getFd"), [getMergeDeployment]("GI.OSTree.Objects.Sysroot#g:method:getMergeDeployment"), [getPath]("GI.OSTree.Objects.Sysroot#g:method:getPath"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRepo]("GI.OSTree.Objects.Sysroot#g:method:getRepo"), [getStagedDeployment]("GI.OSTree.Objects.Sysroot#g:method:getStagedDeployment"), [getSubbootversion]("GI.OSTree.Objects.Sysroot#g:method:getSubbootversion").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setMountNamespaceInUse]("GI.OSTree.Objects.Sysroot#g:method:setMountNamespaceInUse"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveSysrootMethod                    ,
#endif

-- ** cleanup #method:cleanup#

#if defined(ENABLE_OVERLOADING)
    SysrootCleanupMethodInfo                ,
#endif
    sysrootCleanup                          ,


-- ** cleanupPruneRepo #method:cleanupPruneRepo#

#if defined(ENABLE_OVERLOADING)
    SysrootCleanupPruneRepoMethodInfo       ,
#endif
    sysrootCleanupPruneRepo                 ,


-- ** deployTree #method:deployTree#

#if defined(ENABLE_OVERLOADING)
    SysrootDeployTreeMethodInfo             ,
#endif
    sysrootDeployTree                       ,


-- ** deployTreeWithOptions #method:deployTreeWithOptions#

#if defined(ENABLE_OVERLOADING)
    SysrootDeployTreeWithOptionsMethodInfo  ,
#endif
    sysrootDeployTreeWithOptions            ,


-- ** deploymentSetKargs #method:deploymentSetKargs#

#if defined(ENABLE_OVERLOADING)
    SysrootDeploymentSetKargsMethodInfo     ,
#endif
    sysrootDeploymentSetKargs               ,


-- ** deploymentSetMutable #method:deploymentSetMutable#

#if defined(ENABLE_OVERLOADING)
    SysrootDeploymentSetMutableMethodInfo   ,
#endif
    sysrootDeploymentSetMutable             ,


-- ** deploymentSetPinned #method:deploymentSetPinned#

#if defined(ENABLE_OVERLOADING)
    SysrootDeploymentSetPinnedMethodInfo    ,
#endif
    sysrootDeploymentSetPinned              ,


-- ** deploymentUnlock #method:deploymentUnlock#

#if defined(ENABLE_OVERLOADING)
    SysrootDeploymentUnlockMethodInfo       ,
#endif
    sysrootDeploymentUnlock                 ,


-- ** ensureInitialized #method:ensureInitialized#

#if defined(ENABLE_OVERLOADING)
    SysrootEnsureInitializedMethodInfo      ,
#endif
    sysrootEnsureInitialized                ,


-- ** getBootedDeployment #method:getBootedDeployment#

#if defined(ENABLE_OVERLOADING)
    SysrootGetBootedDeploymentMethodInfo    ,
#endif
    sysrootGetBootedDeployment              ,


-- ** getBootversion #method:getBootversion#

#if defined(ENABLE_OVERLOADING)
    SysrootGetBootversionMethodInfo         ,
#endif
    sysrootGetBootversion                   ,


-- ** getDeploymentDirectory #method:getDeploymentDirectory#

#if defined(ENABLE_OVERLOADING)
    SysrootGetDeploymentDirectoryMethodInfo ,
#endif
    sysrootGetDeploymentDirectory           ,


-- ** getDeploymentDirpath #method:getDeploymentDirpath#

#if defined(ENABLE_OVERLOADING)
    SysrootGetDeploymentDirpathMethodInfo   ,
#endif
    sysrootGetDeploymentDirpath             ,


-- ** getDeploymentOriginPath #method:getDeploymentOriginPath#

    sysrootGetDeploymentOriginPath          ,


-- ** getDeployments #method:getDeployments#

#if defined(ENABLE_OVERLOADING)
    SysrootGetDeploymentsMethodInfo         ,
#endif
    sysrootGetDeployments                   ,


-- ** getFd #method:getFd#

#if defined(ENABLE_OVERLOADING)
    SysrootGetFdMethodInfo                  ,
#endif
    sysrootGetFd                            ,


-- ** getMergeDeployment #method:getMergeDeployment#

#if defined(ENABLE_OVERLOADING)
    SysrootGetMergeDeploymentMethodInfo     ,
#endif
    sysrootGetMergeDeployment               ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    SysrootGetPathMethodInfo                ,
#endif
    sysrootGetPath                          ,


-- ** getRepo #method:getRepo#

#if defined(ENABLE_OVERLOADING)
    SysrootGetRepoMethodInfo                ,
#endif
    sysrootGetRepo                          ,


-- ** getStagedDeployment #method:getStagedDeployment#

#if defined(ENABLE_OVERLOADING)
    SysrootGetStagedDeploymentMethodInfo    ,
#endif
    sysrootGetStagedDeployment              ,


-- ** getSubbootversion #method:getSubbootversion#

#if defined(ENABLE_OVERLOADING)
    SysrootGetSubbootversionMethodInfo      ,
#endif
    sysrootGetSubbootversion                ,


-- ** initOsname #method:initOsname#

#if defined(ENABLE_OVERLOADING)
    SysrootInitOsnameMethodInfo             ,
#endif
    sysrootInitOsname                       ,


-- ** initialize #method:initialize#

#if defined(ENABLE_OVERLOADING)
    SysrootInitializeMethodInfo             ,
#endif
    sysrootInitialize                       ,


-- ** isBooted #method:isBooted#

#if defined(ENABLE_OVERLOADING)
    SysrootIsBootedMethodInfo               ,
#endif
    sysrootIsBooted                         ,


-- ** load #method:load#

#if defined(ENABLE_OVERLOADING)
    SysrootLoadMethodInfo                   ,
#endif
    sysrootLoad                             ,


-- ** lock #method:lock#

#if defined(ENABLE_OVERLOADING)
    SysrootLockMethodInfo                   ,
#endif
    sysrootLock                             ,


-- ** lockAsync #method:lockAsync#

#if defined(ENABLE_OVERLOADING)
    SysrootLockAsyncMethodInfo              ,
#endif
    sysrootLockAsync                        ,


-- ** lockFinish #method:lockFinish#

#if defined(ENABLE_OVERLOADING)
    SysrootLockFinishMethodInfo             ,
#endif
    sysrootLockFinish                       ,


-- ** new #method:new#

    sysrootNew                              ,


-- ** newDefault #method:newDefault#

    sysrootNewDefault                       ,


-- ** originNewFromRefspec #method:originNewFromRefspec#

#if defined(ENABLE_OVERLOADING)
    SysrootOriginNewFromRefspecMethodInfo   ,
#endif
    sysrootOriginNewFromRefspec             ,


-- ** prepareCleanup #method:prepareCleanup#

#if defined(ENABLE_OVERLOADING)
    SysrootPrepareCleanupMethodInfo         ,
#endif
    sysrootPrepareCleanup                   ,


-- ** queryDeploymentsFor #method:queryDeploymentsFor#

#if defined(ENABLE_OVERLOADING)
    SysrootQueryDeploymentsForMethodInfo    ,
#endif
    sysrootQueryDeploymentsFor              ,


-- ** repo #method:repo#

#if defined(ENABLE_OVERLOADING)
    SysrootRepoMethodInfo                   ,
#endif
    sysrootRepo                             ,


-- ** requireBootedDeployment #method:requireBootedDeployment#

#if defined(ENABLE_OVERLOADING)
    SysrootRequireBootedDeploymentMethodInfo,
#endif
    sysrootRequireBootedDeployment          ,


-- ** setMountNamespaceInUse #method:setMountNamespaceInUse#

#if defined(ENABLE_OVERLOADING)
    SysrootSetMountNamespaceInUseMethodInfo ,
#endif
    sysrootSetMountNamespaceInUse           ,


-- ** simpleWriteDeployment #method:simpleWriteDeployment#

#if defined(ENABLE_OVERLOADING)
    SysrootSimpleWriteDeploymentMethodInfo  ,
#endif
    sysrootSimpleWriteDeployment            ,


-- ** stageOverlayInitrd #method:stageOverlayInitrd#

#if defined(ENABLE_OVERLOADING)
    SysrootStageOverlayInitrdMethodInfo     ,
#endif
    sysrootStageOverlayInitrd               ,


-- ** stageTree #method:stageTree#

#if defined(ENABLE_OVERLOADING)
    SysrootStageTreeMethodInfo              ,
#endif
    sysrootStageTree                        ,


-- ** stageTreeWithOptions #method:stageTreeWithOptions#

#if defined(ENABLE_OVERLOADING)
    SysrootStageTreeWithOptionsMethodInfo   ,
#endif
    sysrootStageTreeWithOptions             ,


-- ** tryLock #method:tryLock#

#if defined(ENABLE_OVERLOADING)
    SysrootTryLockMethodInfo                ,
#endif
    sysrootTryLock                          ,


-- ** unload #method:unload#

#if defined(ENABLE_OVERLOADING)
    SysrootUnloadMethodInfo                 ,
#endif
    sysrootUnload                           ,


-- ** unlock #method:unlock#

#if defined(ENABLE_OVERLOADING)
    SysrootUnlockMethodInfo                 ,
#endif
    sysrootUnlock                           ,


-- ** writeDeployments #method:writeDeployments#

#if defined(ENABLE_OVERLOADING)
    SysrootWriteDeploymentsMethodInfo       ,
#endif
    sysrootWriteDeployments                 ,


-- ** writeDeploymentsWithOptions #method:writeDeploymentsWithOptions#

#if defined(ENABLE_OVERLOADING)
    SysrootWriteDeploymentsWithOptionsMethodInfo,
#endif
    sysrootWriteDeploymentsWithOptions      ,


-- ** writeOriginFile #method:writeOriginFile#

#if defined(ENABLE_OVERLOADING)
    SysrootWriteOriginFileMethodInfo        ,
#endif
    sysrootWriteOriginFile                  ,




 -- * Properties


-- ** path #attr:path#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    SysrootPathPropertyInfo                 ,
#endif
    constructSysrootPath                    ,
    getSysrootPath                          ,
#if defined(ENABLE_OVERLOADING)
    sysrootPath                             ,
#endif




 -- * Signals


-- ** journalMsg #signal:journalMsg#

    SysrootJournalMsgCallback               ,
#if defined(ENABLE_OVERLOADING)
    SysrootJournalMsgSignalInfo             ,
#endif
    afterSysrootJournalMsg                  ,
    onSysrootJournalMsg                     ,




    ) where

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

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

import qualified GI.GLib.Structs.KeyFile as GLib.KeyFile
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import {-# SOURCE #-} qualified GI.OSTree.Enums as OSTree.Enums
import {-# SOURCE #-} qualified GI.OSTree.Flags as OSTree.Flags
import {-# SOURCE #-} qualified GI.OSTree.Objects.Deployment as OSTree.Deployment
import {-# SOURCE #-} qualified GI.OSTree.Objects.Repo as OSTree.Repo
import {-# SOURCE #-} qualified GI.OSTree.Structs.RepoPruneOptions as OSTree.RepoPruneOptions
import {-# SOURCE #-} qualified GI.OSTree.Structs.SysrootDeployTreeOpts as OSTree.SysrootDeployTreeOpts
import {-# SOURCE #-} qualified GI.OSTree.Structs.SysrootWriteDeploymentsOpts as OSTree.SysrootWriteDeploymentsOpts

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

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

foreign import ccall "ostree_sysroot_get_type"
    c_ostree_sysroot_get_type :: IO B.Types.GType

instance B.Types.TypedObject Sysroot where
    glibType :: IO GType
glibType = IO GType
c_ostree_sysroot_get_type

instance B.Types.GObject Sysroot

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveSysrootMethod (t :: Symbol) (o :: *) :: * where
    ResolveSysrootMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveSysrootMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveSysrootMethod "cleanup" o = SysrootCleanupMethodInfo
    ResolveSysrootMethod "cleanupPruneRepo" o = SysrootCleanupPruneRepoMethodInfo
    ResolveSysrootMethod "deployTree" o = SysrootDeployTreeMethodInfo
    ResolveSysrootMethod "deployTreeWithOptions" o = SysrootDeployTreeWithOptionsMethodInfo
    ResolveSysrootMethod "deploymentSetKargs" o = SysrootDeploymentSetKargsMethodInfo
    ResolveSysrootMethod "deploymentSetMutable" o = SysrootDeploymentSetMutableMethodInfo
    ResolveSysrootMethod "deploymentSetPinned" o = SysrootDeploymentSetPinnedMethodInfo
    ResolveSysrootMethod "deploymentUnlock" o = SysrootDeploymentUnlockMethodInfo
    ResolveSysrootMethod "ensureInitialized" o = SysrootEnsureInitializedMethodInfo
    ResolveSysrootMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveSysrootMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveSysrootMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveSysrootMethod "initOsname" o = SysrootInitOsnameMethodInfo
    ResolveSysrootMethod "initialize" o = SysrootInitializeMethodInfo
    ResolveSysrootMethod "isBooted" o = SysrootIsBootedMethodInfo
    ResolveSysrootMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveSysrootMethod "load" o = SysrootLoadMethodInfo
    ResolveSysrootMethod "loadIfChanged" o = SysrootLoadIfChangedMethodInfo
    ResolveSysrootMethod "lock" o = SysrootLockMethodInfo
    ResolveSysrootMethod "lockAsync" o = SysrootLockAsyncMethodInfo
    ResolveSysrootMethod "lockFinish" o = SysrootLockFinishMethodInfo
    ResolveSysrootMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveSysrootMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveSysrootMethod "originNewFromRefspec" o = SysrootOriginNewFromRefspecMethodInfo
    ResolveSysrootMethod "prepareCleanup" o = SysrootPrepareCleanupMethodInfo
    ResolveSysrootMethod "queryDeploymentsFor" o = SysrootQueryDeploymentsForMethodInfo
    ResolveSysrootMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveSysrootMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveSysrootMethod "repo" o = SysrootRepoMethodInfo
    ResolveSysrootMethod "requireBootedDeployment" o = SysrootRequireBootedDeploymentMethodInfo
    ResolveSysrootMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveSysrootMethod "simpleWriteDeployment" o = SysrootSimpleWriteDeploymentMethodInfo
    ResolveSysrootMethod "stageOverlayInitrd" o = SysrootStageOverlayInitrdMethodInfo
    ResolveSysrootMethod "stageTree" o = SysrootStageTreeMethodInfo
    ResolveSysrootMethod "stageTreeWithOptions" o = SysrootStageTreeWithOptionsMethodInfo
    ResolveSysrootMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveSysrootMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveSysrootMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveSysrootMethod "tryLock" o = SysrootTryLockMethodInfo
    ResolveSysrootMethod "unload" o = SysrootUnloadMethodInfo
    ResolveSysrootMethod "unlock" o = SysrootUnlockMethodInfo
    ResolveSysrootMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveSysrootMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveSysrootMethod "writeDeployments" o = SysrootWriteDeploymentsMethodInfo
    ResolveSysrootMethod "writeDeploymentsWithOptions" o = SysrootWriteDeploymentsWithOptionsMethodInfo
    ResolveSysrootMethod "writeOriginFile" o = SysrootWriteOriginFileMethodInfo
    ResolveSysrootMethod "getBootedDeployment" o = SysrootGetBootedDeploymentMethodInfo
    ResolveSysrootMethod "getBootversion" o = SysrootGetBootversionMethodInfo
    ResolveSysrootMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveSysrootMethod "getDeploymentDirectory" o = SysrootGetDeploymentDirectoryMethodInfo
    ResolveSysrootMethod "getDeploymentDirpath" o = SysrootGetDeploymentDirpathMethodInfo
    ResolveSysrootMethod "getDeployments" o = SysrootGetDeploymentsMethodInfo
    ResolveSysrootMethod "getFd" o = SysrootGetFdMethodInfo
    ResolveSysrootMethod "getMergeDeployment" o = SysrootGetMergeDeploymentMethodInfo
    ResolveSysrootMethod "getPath" o = SysrootGetPathMethodInfo
    ResolveSysrootMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveSysrootMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveSysrootMethod "getRepo" o = SysrootGetRepoMethodInfo
    ResolveSysrootMethod "getStagedDeployment" o = SysrootGetStagedDeploymentMethodInfo
    ResolveSysrootMethod "getSubbootversion" o = SysrootGetSubbootversionMethodInfo
    ResolveSysrootMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveSysrootMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveSysrootMethod "setMountNamespaceInUse" o = SysrootSetMountNamespaceInUseMethodInfo
    ResolveSysrootMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveSysrootMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal Sysroot::journal-msg
-- | libostree will log to the journal various events, such as the \/etc merge
-- status, and transaction completion. Connect to this signal to also
-- synchronously receive the text for those messages. This is intended to be
-- used by command line tools which link to libostree as a library.
-- 
-- Currently, the structured data is only available via the systemd journal.
-- 
-- /Since: 2017.10/
type SysrootJournalMsgCallback =
    T.Text
    -- ^ /@msg@/: Human-readable string (should not contain newlines)
    -> IO ()

type C_SysrootJournalMsgCallback =
    Ptr Sysroot ->                          -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_SysrootJournalMsgCallback :: 
    GObject a => (a -> SysrootJournalMsgCallback) ->
    C_SysrootJournalMsgCallback
wrap_SysrootJournalMsgCallback :: forall a.
GObject a =>
(a -> SysrootJournalMsgCallback) -> C_SysrootJournalMsgCallback
wrap_SysrootJournalMsgCallback a -> SysrootJournalMsgCallback
gi'cb Ptr Sysroot
gi'selfPtr CString
msg Ptr ()
_ = do
    Text
msg' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
msg
    Ptr Sysroot -> (Sysroot -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr Sysroot
gi'selfPtr ((Sysroot -> IO ()) -> IO ()) -> (Sysroot -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Sysroot
gi'self -> a -> SysrootJournalMsgCallback
gi'cb (Sysroot -> a
Coerce.coerce Sysroot
gi'self)  Text
msg'


-- | Connect a signal handler for the [journalMsg](#signal:journalMsg) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' sysroot #journalMsg callback
-- @
-- 
-- 
onSysrootJournalMsg :: (IsSysroot a, MonadIO m) => a -> ((?self :: a) => SysrootJournalMsgCallback) -> m SignalHandlerId
onSysrootJournalMsg :: forall a (m :: * -> *).
(IsSysroot a, MonadIO m) =>
a -> ((?self::a) => SysrootJournalMsgCallback) -> m SignalHandlerId
onSysrootJournalMsg a
obj (?self::a) => SysrootJournalMsgCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SysrootJournalMsgCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SysrootJournalMsgCallback
SysrootJournalMsgCallback
cb
    let wrapped' :: C_SysrootJournalMsgCallback
wrapped' = (a -> SysrootJournalMsgCallback) -> C_SysrootJournalMsgCallback
forall a.
GObject a =>
(a -> SysrootJournalMsgCallback) -> C_SysrootJournalMsgCallback
wrap_SysrootJournalMsgCallback a -> SysrootJournalMsgCallback
wrapped
    FunPtr C_SysrootJournalMsgCallback
wrapped'' <- C_SysrootJournalMsgCallback
-> IO (FunPtr C_SysrootJournalMsgCallback)
mk_SysrootJournalMsgCallback C_SysrootJournalMsgCallback
wrapped'
    a
-> Text
-> FunPtr C_SysrootJournalMsgCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"journal-msg" FunPtr C_SysrootJournalMsgCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [journalMsg](#signal:journalMsg) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' sysroot #journalMsg callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterSysrootJournalMsg :: (IsSysroot a, MonadIO m) => a -> ((?self :: a) => SysrootJournalMsgCallback) -> m SignalHandlerId
afterSysrootJournalMsg :: forall a (m :: * -> *).
(IsSysroot a, MonadIO m) =>
a -> ((?self::a) => SysrootJournalMsgCallback) -> m SignalHandlerId
afterSysrootJournalMsg a
obj (?self::a) => SysrootJournalMsgCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> SysrootJournalMsgCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => SysrootJournalMsgCallback
SysrootJournalMsgCallback
cb
    let wrapped' :: C_SysrootJournalMsgCallback
wrapped' = (a -> SysrootJournalMsgCallback) -> C_SysrootJournalMsgCallback
forall a.
GObject a =>
(a -> SysrootJournalMsgCallback) -> C_SysrootJournalMsgCallback
wrap_SysrootJournalMsgCallback a -> SysrootJournalMsgCallback
wrapped
    FunPtr C_SysrootJournalMsgCallback
wrapped'' <- C_SysrootJournalMsgCallback
-> IO (FunPtr C_SysrootJournalMsgCallback)
mk_SysrootJournalMsgCallback C_SysrootJournalMsgCallback
wrapped'
    a
-> Text
-> FunPtr C_SysrootJournalMsgCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"journal-msg" FunPtr C_SysrootJournalMsgCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data SysrootJournalMsgSignalInfo
instance SignalInfo SysrootJournalMsgSignalInfo where
    type HaskellCallbackType SysrootJournalMsgSignalInfo = SysrootJournalMsgCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_SysrootJournalMsgCallback cb
        cb'' <- mk_SysrootJournalMsgCallback cb'
        connectSignalFunPtr obj "journal-msg" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot::journal-msg"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#g:signal:journalMsg"})

#endif

-- VVV Prop "path"
   -- Type: TInterface (Name {namespace = "Gio", name = "File"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' sysroot #path
-- @
getSysrootPath :: (MonadIO m, IsSysroot o) => o -> m Gio.File.File
getSysrootPath :: forall (m :: * -> *) o. (MonadIO m, IsSysroot o) => o -> m File
getSysrootPath o
obj = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe File) -> IO File
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getSysrootPath" (IO (Maybe File) -> IO File) -> IO (Maybe File) -> IO File
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr File -> File) -> IO (Maybe File)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj String
"path" ManagedPtr File -> File
Gio.File.File

-- | Construct a `GValueConstruct` with valid value for the “@path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructSysrootPath :: (IsSysroot o, MIO.MonadIO m, Gio.File.IsFile a) => a -> m (GValueConstruct o)
constructSysrootPath :: forall o (m :: * -> *) a.
(IsSysroot o, MonadIO m, IsFile a) =>
a -> m (GValueConstruct o)
constructSysrootPath a
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject String
"path" (a -> Maybe a
forall a. a -> Maybe a
P.Just a
val)

#if defined(ENABLE_OVERLOADING)
data SysrootPathPropertyInfo
instance AttrInfo SysrootPathPropertyInfo where
    type AttrAllowedOps SysrootPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint SysrootPathPropertyInfo = IsSysroot
    type AttrSetTypeConstraint SysrootPathPropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint SysrootPathPropertyInfo = Gio.File.IsFile
    type AttrTransferType SysrootPathPropertyInfo = Gio.File.File
    type AttrGetType SysrootPathPropertyInfo = Gio.File.File
    type AttrLabel SysrootPathPropertyInfo = "path"
    type AttrOrigin SysrootPathPropertyInfo = Sysroot
    attrGet = getSysrootPath
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructSysrootPath
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.path"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#g:attr:path"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Sysroot
type instance O.AttributeList Sysroot = SysrootAttributeList
type SysrootAttributeList = ('[ '("path", SysrootPathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
sysrootPath :: AttrLabelProxy "path"
sysrootPath = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Sysroot = SysrootSignalList
type SysrootSignalList = ('[ '("journalMsg", SysrootJournalMsgSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method Sysroot::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Path to a system root directory, or %NULL to use the\n  current visible root file system"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "OSTree" , name = "Sysroot" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_new" ostree_sysroot_new :: 
    Ptr Gio.File.File ->                    -- path : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr Sysroot)

-- | Create a new t'GI.OSTree.Objects.Sysroot.Sysroot' object for the sysroot at /@path@/. If /@path@/ is 'P.Nothing',
-- the current visible root file system is used, equivalent to
-- 'GI.OSTree.Objects.Sysroot.sysrootNewDefault'.
sysrootNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    Maybe (a)
    -- ^ /@path@/: Path to a system root directory, or 'P.Nothing' to use the
    --   current visible root file system
    -> m Sysroot
    -- ^ __Returns:__ An accessor object for an system root located at /@path@/
sysrootNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
Maybe a -> m Sysroot
sysrootNew Maybe a
path = IO Sysroot -> m Sysroot
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sysroot -> m Sysroot) -> IO Sysroot -> m Sysroot
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
maybePath <- case Maybe a
path of
        Maybe a
Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just a
jPath -> do
            Ptr File
jPath' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jPath
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jPath'
    Ptr Sysroot
result <- Ptr File -> IO (Ptr Sysroot)
ostree_sysroot_new Ptr File
maybePath
    Text -> Ptr Sysroot -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootNew" Ptr Sysroot
result
    Sysroot
result' <- ((ManagedPtr Sysroot -> Sysroot) -> Ptr Sysroot -> IO Sysroot
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Sysroot -> Sysroot
Sysroot) Ptr Sysroot
result
    Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
path a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Sysroot -> IO Sysroot
forall (m :: * -> *) a. Monad m => a -> m a
return Sysroot
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Sysroot::new_default
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "OSTree" , name = "Sysroot" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_new_default" ostree_sysroot_new_default :: 
    IO (Ptr Sysroot)

-- | /No description available in the introspection data./
sysrootNewDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Sysroot
    -- ^ __Returns:__ An accessor for the current visible root \/ filesystem
sysrootNewDefault :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Sysroot
sysrootNewDefault  = IO Sysroot -> m Sysroot
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Sysroot -> m Sysroot) -> IO Sysroot -> m Sysroot
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
result <- IO (Ptr Sysroot)
ostree_sysroot_new_default
    Text -> Ptr Sysroot -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootNewDefault" Ptr Sysroot
result
    Sysroot
result' <- ((ManagedPtr Sysroot -> Sysroot) -> Ptr Sysroot -> IO Sysroot
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Sysroot -> Sysroot
Sysroot) Ptr Sysroot
result
    Sysroot -> IO Sysroot
forall (m :: * -> *) a. Monad m => a -> m a
return Sysroot
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Sysroot::cleanup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_cleanup" ostree_sysroot_cleanup :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Delete any state that resulted from a partially completed
-- transaction, such as incomplete deployments.
sysrootCleanup ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootCleanup :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> Maybe b -> m ()
sysrootCleanup a
self Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_cleanup Ptr Sysroot
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootCleanupMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootCleanupMethodInfo a signature where
    overloadedMethod = sysrootCleanup

instance O.OverloadedMethodInfo SysrootCleanupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootCleanup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootCleanup"
        })


#endif

-- method Sysroot::cleanup_prune_repo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sysroot"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoPruneOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags controlling pruning"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_objects_total"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of objects found"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_objects_pruned"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of objects deleted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_pruned_object_size_total"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Storage size in bytes of objects deleted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_cleanup_prune_repo" ostree_sysroot_cleanup_prune_repo :: 
    Ptr Sysroot ->                          -- sysroot : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr OSTree.RepoPruneOptions.RepoPruneOptions -> -- options : TInterface (Name {namespace = "OSTree", name = "RepoPruneOptions"})
    Ptr Int32 ->                            -- out_objects_total : TBasicType TInt
    Ptr Int32 ->                            -- out_objects_pruned : TBasicType TInt
    Ptr Word64 ->                           -- out_pruned_object_size_total : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Prune the system repository.  This is a thin wrapper
-- around 'GI.OSTree.Objects.Repo.repoPruneFromReachable'; the primary
-- addition is that this function automatically gathers
-- all deployed commits into the reachable set.
-- 
-- You generally want to at least set the @OSTREE_REPO_PRUNE_FLAGS_REFS_ONLY@
-- flag in /@options@/.  A commit traversal depth of @0@ is assumed.
-- 
-- Locking: exclusive
-- 
-- /Since: 2018.6/
sysrootCleanupPruneRepo ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@sysroot@/: Sysroot
    -> OSTree.RepoPruneOptions.RepoPruneOptions
    -- ^ /@options@/: Flags controlling pruning
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ((Int32, Int32, Word64))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootCleanupPruneRepo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> RepoPruneOptions -> Maybe b -> m (Int32, Int32, Word64)
sysrootCleanupPruneRepo a
sysroot RepoPruneOptions
options Maybe b
cancellable = IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64))
-> IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
sysroot' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sysroot
    Ptr RepoPruneOptions
options' <- RepoPruneOptions -> IO (Ptr RepoPruneOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RepoPruneOptions
options
    Ptr Int32
outObjectsTotal <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
outObjectsPruned <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Word64
outPrunedObjectSizeTotal <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Int32, Int32, Word64) -> IO () -> IO (Int32, Int32, Word64)
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr RepoPruneOptions
-> Ptr Int32
-> Ptr Int32
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_cleanup_prune_repo Ptr Sysroot
sysroot' Ptr RepoPruneOptions
options' Ptr Int32
outObjectsTotal Ptr Int32
outObjectsPruned Ptr Word64
outPrunedObjectSizeTotal Ptr Cancellable
maybeCancellable
        Int32
outObjectsTotal' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
outObjectsTotal
        Int32
outObjectsPruned' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
outObjectsPruned
        Word64
outPrunedObjectSizeTotal' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outPrunedObjectSizeTotal
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sysroot
        RepoPruneOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RepoPruneOptions
options
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsTotal
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsPruned
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outPrunedObjectSizeTotal
        (Int32, Int32, Word64) -> IO (Int32, Int32, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
outObjectsTotal', Int32
outObjectsPruned', Word64
outPrunedObjectSizeTotal')
     ) (do
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsTotal
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsPruned
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outPrunedObjectSizeTotal
     )

#if defined(ENABLE_OVERLOADING)
data SysrootCleanupPruneRepoMethodInfo
instance (signature ~ (OSTree.RepoPruneOptions.RepoPruneOptions -> Maybe (b) -> m ((Int32, Int32, Word64))), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootCleanupPruneRepoMethodInfo a signature where
    overloadedMethod = sysrootCleanupPruneRepo

instance O.OverloadedMethodInfo SysrootCleanupPruneRepoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootCleanupPruneRepo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootCleanupPruneRepo"
        })


#endif

-- method Sysroot::deploy_tree
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "osname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "osname to use for merge deployment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "revision"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Origin to use for upgrades"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "provided_merge_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Use this deployment for merge path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "override_kernel_argv"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Use these as kernel arguments; if %NULL, inherit options from provided_merge_deployment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_new_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new deployment path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_deploy_tree" ostree_sysroot_deploy_tree :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- osname : TBasicType TUTF8
    CString ->                              -- revision : TBasicType TUTF8
    Ptr GLib.KeyFile.KeyFile ->             -- origin : TInterface (Name {namespace = "GLib", name = "KeyFile"})
    Ptr OSTree.Deployment.Deployment ->     -- provided_merge_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr CString ->                          -- override_kernel_argv : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr (Ptr OSTree.Deployment.Deployment) -> -- out_new_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Older version of 'GI.OSTree.Objects.Sysroot.sysrootStageTreeWithOptions'.
-- 
-- /Since: 2018.5/
sysrootDeployTree ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (T.Text)
    -- ^ /@osname@/: osname to use for merge deployment
    -> T.Text
    -- ^ /@revision@/: Checksum to add
    -> Maybe (GLib.KeyFile.KeyFile)
    -- ^ /@origin@/: Origin to use for upgrades
    -> Maybe (b)
    -- ^ /@providedMergeDeployment@/: Use this deployment for merge path
    -> Maybe ([T.Text])
    -- ^ /@overrideKernelArgv@/: Use these as kernel arguments; if 'P.Nothing', inherit options from provided_merge_deployment
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m (OSTree.Deployment.Deployment)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootDeployTree :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsCancellable c) =>
a
-> Maybe Text
-> Text
-> Maybe KeyFile
-> Maybe b
-> Maybe [Text]
-> Maybe c
-> m Deployment
sysrootDeployTree a
self Maybe Text
osname Text
revision Maybe KeyFile
origin Maybe b
providedMergeDeployment Maybe [Text]
overrideKernelArgv Maybe c
cancellable = IO Deployment -> m Deployment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Deployment -> m Deployment) -> IO Deployment -> m Deployment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeOsname <- case Maybe Text
osname of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jOsname -> do
            CString
jOsname' <- Text -> IO CString
textToCString Text
jOsname
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOsname'
    CString
revision' <- Text -> IO CString
textToCString Text
revision
    Ptr KeyFile
maybeOrigin <- case Maybe KeyFile
origin of
        Maybe KeyFile
Nothing -> Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
forall a. Ptr a
nullPtr
        Just KeyFile
jOrigin -> do
            Ptr KeyFile
jOrigin' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
jOrigin
            Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
jOrigin'
    Ptr Deployment
maybeProvidedMergeDeployment <- case Maybe b
providedMergeDeployment of
        Maybe b
Nothing -> Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
forall a. Ptr a
nullPtr
        Just b
jProvidedMergeDeployment -> do
            Ptr Deployment
jProvidedMergeDeployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProvidedMergeDeployment
            Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
jProvidedMergeDeployment'
    Ptr CString
maybeOverrideKernelArgv <- case Maybe [Text]
overrideKernelArgv of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jOverrideKernelArgv -> do
            Ptr CString
jOverrideKernelArgv' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jOverrideKernelArgv
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jOverrideKernelArgv'
    Ptr (Ptr Deployment)
outNewDeployment <- IO (Ptr (Ptr Deployment))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr OSTree.Deployment.Deployment))
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Deployment -> IO () -> IO Deployment
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> CString
-> CString
-> Ptr KeyFile
-> Ptr Deployment
-> Ptr CString
-> Ptr (Ptr Deployment)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_deploy_tree Ptr Sysroot
self' CString
maybeOsname CString
revision' Ptr KeyFile
maybeOrigin Ptr Deployment
maybeProvidedMergeDeployment Ptr CString
maybeOverrideKernelArgv Ptr (Ptr Deployment)
outNewDeployment Ptr Cancellable
maybeCancellable
        Ptr Deployment
outNewDeployment' <- Ptr (Ptr Deployment) -> IO (Ptr Deployment)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Deployment)
outNewDeployment
        Deployment
outNewDeployment'' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
outNewDeployment'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe KeyFile -> (KeyFile -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe KeyFile
origin KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
providedMergeDeployment b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
revision'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeOverrideKernelArgv
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeOverrideKernelArgv
        Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outNewDeployment
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
outNewDeployment''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
revision'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeOverrideKernelArgv
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeOverrideKernelArgv
        Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outNewDeployment
     )

#if defined(ENABLE_OVERLOADING)
data SysrootDeployTreeMethodInfo
instance (signature ~ (Maybe (T.Text) -> T.Text -> Maybe (GLib.KeyFile.KeyFile) -> Maybe (b) -> Maybe ([T.Text]) -> Maybe (c) -> m (OSTree.Deployment.Deployment)), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SysrootDeployTreeMethodInfo a signature where
    overloadedMethod = sysrootDeployTree

instance O.OverloadedMethodInfo SysrootDeployTreeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootDeployTree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootDeployTree"
        })


#endif

-- method Sysroot::deploy_tree_with_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "osname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "osname to use for merge deployment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "revision"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Origin to use for upgrades"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "provided_merge_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Use this deployment for merge path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "opts"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "SysrootDeployTreeOpts" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_new_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new deployment path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_deploy_tree_with_options" ostree_sysroot_deploy_tree_with_options :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- osname : TBasicType TUTF8
    CString ->                              -- revision : TBasicType TUTF8
    Ptr GLib.KeyFile.KeyFile ->             -- origin : TInterface (Name {namespace = "GLib", name = "KeyFile"})
    Ptr OSTree.Deployment.Deployment ->     -- provided_merge_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr OSTree.SysrootDeployTreeOpts.SysrootDeployTreeOpts -> -- opts : TInterface (Name {namespace = "OSTree", name = "SysrootDeployTreeOpts"})
    Ptr (Ptr OSTree.Deployment.Deployment) -> -- out_new_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Check out deployment tree with revision /@revision@/, performing a 3
-- way merge with /@providedMergeDeployment@/ for configuration.
-- 
-- When booted into the sysroot, you should use the
-- 'GI.OSTree.Objects.Sysroot.sysrootStageTree' API instead.
-- 
-- /Since: 2020.7/
sysrootDeployTreeWithOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (T.Text)
    -- ^ /@osname@/: osname to use for merge deployment
    -> T.Text
    -- ^ /@revision@/: Checksum to add
    -> Maybe (GLib.KeyFile.KeyFile)
    -- ^ /@origin@/: Origin to use for upgrades
    -> Maybe (b)
    -- ^ /@providedMergeDeployment@/: Use this deployment for merge path
    -> Maybe (OSTree.SysrootDeployTreeOpts.SysrootDeployTreeOpts)
    -- ^ /@opts@/: Options
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m (OSTree.Deployment.Deployment)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootDeployTreeWithOptions :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsCancellable c) =>
a
-> Maybe Text
-> Text
-> Maybe KeyFile
-> Maybe b
-> Maybe SysrootDeployTreeOpts
-> Maybe c
-> m Deployment
sysrootDeployTreeWithOptions a
self Maybe Text
osname Text
revision Maybe KeyFile
origin Maybe b
providedMergeDeployment Maybe SysrootDeployTreeOpts
opts Maybe c
cancellable = IO Deployment -> m Deployment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Deployment -> m Deployment) -> IO Deployment -> m Deployment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeOsname <- case Maybe Text
osname of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jOsname -> do
            CString
jOsname' <- Text -> IO CString
textToCString Text
jOsname
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOsname'
    CString
revision' <- Text -> IO CString
textToCString Text
revision
    Ptr KeyFile
maybeOrigin <- case Maybe KeyFile
origin of
        Maybe KeyFile
Nothing -> Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
forall a. Ptr a
nullPtr
        Just KeyFile
jOrigin -> do
            Ptr KeyFile
jOrigin' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
jOrigin
            Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
jOrigin'
    Ptr Deployment
maybeProvidedMergeDeployment <- case Maybe b
providedMergeDeployment of
        Maybe b
Nothing -> Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
forall a. Ptr a
nullPtr
        Just b
jProvidedMergeDeployment -> do
            Ptr Deployment
jProvidedMergeDeployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProvidedMergeDeployment
            Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
jProvidedMergeDeployment'
    Ptr SysrootDeployTreeOpts
maybeOpts <- case Maybe SysrootDeployTreeOpts
opts of
        Maybe SysrootDeployTreeOpts
Nothing -> Ptr SysrootDeployTreeOpts -> IO (Ptr SysrootDeployTreeOpts)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SysrootDeployTreeOpts
forall a. Ptr a
nullPtr
        Just SysrootDeployTreeOpts
jOpts -> do
            Ptr SysrootDeployTreeOpts
jOpts' <- SysrootDeployTreeOpts -> IO (Ptr SysrootDeployTreeOpts)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SysrootDeployTreeOpts
jOpts
            Ptr SysrootDeployTreeOpts -> IO (Ptr SysrootDeployTreeOpts)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SysrootDeployTreeOpts
jOpts'
    Ptr (Ptr Deployment)
outNewDeployment <- IO (Ptr (Ptr Deployment))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr OSTree.Deployment.Deployment))
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Deployment -> IO () -> IO Deployment
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> CString
-> CString
-> Ptr KeyFile
-> Ptr Deployment
-> Ptr SysrootDeployTreeOpts
-> Ptr (Ptr Deployment)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_deploy_tree_with_options Ptr Sysroot
self' CString
maybeOsname CString
revision' Ptr KeyFile
maybeOrigin Ptr Deployment
maybeProvidedMergeDeployment Ptr SysrootDeployTreeOpts
maybeOpts Ptr (Ptr Deployment)
outNewDeployment Ptr Cancellable
maybeCancellable
        Ptr Deployment
outNewDeployment' <- Ptr (Ptr Deployment) -> IO (Ptr Deployment)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Deployment)
outNewDeployment
        Deployment
outNewDeployment'' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
outNewDeployment'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe KeyFile -> (KeyFile -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe KeyFile
origin KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
providedMergeDeployment b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe SysrootDeployTreeOpts
-> (SysrootDeployTreeOpts -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe SysrootDeployTreeOpts
opts SysrootDeployTreeOpts -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
revision'
        Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outNewDeployment
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
outNewDeployment''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
revision'
        Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outNewDeployment
     )

#if defined(ENABLE_OVERLOADING)
data SysrootDeployTreeWithOptionsMethodInfo
instance (signature ~ (Maybe (T.Text) -> T.Text -> Maybe (GLib.KeyFile.KeyFile) -> Maybe (b) -> Maybe (OSTree.SysrootDeployTreeOpts.SysrootDeployTreeOpts) -> Maybe (c) -> m (OSTree.Deployment.Deployment)), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SysrootDeployTreeWithOptionsMethodInfo a signature where
    overloadedMethod = sysrootDeployTreeWithOptions

instance O.OverloadedMethodInfo SysrootDeployTreeWithOptionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootDeployTreeWithOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootDeployTreeWithOptions"
        })


#endif

-- method Sysroot::deployment_set_kargs
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A deployment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_kargs"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Replace deployment's kernel arguments"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_deployment_set_kargs" ostree_sysroot_deployment_set_kargs :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr OSTree.Deployment.Deployment ->     -- deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr CString ->                          -- new_kargs : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Entirely replace the kernel arguments of /@deployment@/ with the
-- values in /@newKargs@/.
sysrootDeploymentSetKargs ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Sysroot
    -> b
    -- ^ /@deployment@/: A deployment
    -> [T.Text]
    -- ^ /@newKargs@/: Replace deployment\'s kernel arguments
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootDeploymentSetKargs :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsCancellable c) =>
a -> b -> [Text] -> Maybe c -> m ()
sysrootDeploymentSetKargs a
self b
deployment [Text]
newKargs Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Deployment
deployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
deployment
    Ptr CString
newKargs' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
newKargs
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr Deployment
-> Ptr CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_deployment_set_kargs Ptr Sysroot
self' Ptr Deployment
deployment' Ptr CString
newKargs' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
deployment
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
newKargs'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
newKargs'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
newKargs'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
newKargs'
     )

#if defined(ENABLE_OVERLOADING)
data SysrootDeploymentSetKargsMethodInfo
instance (signature ~ (b -> [T.Text] -> Maybe (c) -> m ()), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SysrootDeploymentSetKargsMethodInfo a signature where
    overloadedMethod = sysrootDeploymentSetKargs

instance O.OverloadedMethodInfo SysrootDeploymentSetKargsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootDeploymentSetKargs",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootDeploymentSetKargs"
        })


#endif

-- method Sysroot::deployment_set_mutable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A deployment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_mutable"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Whether or not deployment's files can be changed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_deployment_set_mutable" ostree_sysroot_deployment_set_mutable :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr OSTree.Deployment.Deployment ->     -- deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    CInt ->                                 -- is_mutable : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | By default, deployment directories are not mutable.  This function
-- will allow making them temporarily mutable, for example to allow
-- layering additional non-OSTree content.
sysrootDeploymentSetMutable ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Sysroot
    -> b
    -- ^ /@deployment@/: A deployment
    -> Bool
    -- ^ /@isMutable@/: Whether or not deployment\'s files can be changed
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootDeploymentSetMutable :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsCancellable c) =>
a -> b -> Bool -> Maybe c -> m ()
sysrootDeploymentSetMutable a
self b
deployment Bool
isMutable Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Deployment
deployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
deployment
    let isMutable' :: CInt
isMutable' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isMutable
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr Deployment
-> CInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_deployment_set_mutable Ptr Sysroot
self' Ptr Deployment
deployment' CInt
isMutable' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
deployment
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootDeploymentSetMutableMethodInfo
instance (signature ~ (b -> Bool -> Maybe (c) -> m ()), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SysrootDeploymentSetMutableMethodInfo a signature where
    overloadedMethod = sysrootDeploymentSetMutable

instance O.OverloadedMethodInfo SysrootDeploymentSetMutableMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootDeploymentSetMutable",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootDeploymentSetMutable"
        })


#endif

-- method Sysroot::deployment_set_pinned
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A deployment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_pinned"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Whether or not deployment will be automatically GC'd"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_deployment_set_pinned" ostree_sysroot_deployment_set_pinned :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr OSTree.Deployment.Deployment ->     -- deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    CInt ->                                 -- is_pinned : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | By default, deployments may be subject to garbage collection. Typical uses of
-- libostree only retain at most 2 deployments. If /@isPinned@/ is @TRUE@, a
-- metadata bit will be set causing libostree to avoid automatic GC of the
-- deployment. However, this is really an \"advisory\" note; it\'s still possible
-- for e.g. older versions of libostree unaware of pinning to GC the deployment.
-- 
-- This function does nothing and returns successfully if the deployment
-- is already in the desired pinning state.  It is an error to try to pin
-- the staged deployment (as it\'s not in the bootloader entries).
-- 
-- /Since: 2018.3/
sysrootDeploymentSetPinned ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b) =>
    a
    -- ^ /@self@/: Sysroot
    -> b
    -- ^ /@deployment@/: A deployment
    -> Bool
    -- ^ /@isPinned@/: Whether or not deployment will be automatically GC\'d
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootDeploymentSetPinned :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b) =>
a -> b -> Bool -> m ()
sysrootDeploymentSetPinned a
self b
deployment Bool
isPinned = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Deployment
deployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
deployment
    let isPinned' :: CInt
isPinned' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isPinned
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr Deployment -> CInt -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_deployment_set_pinned Ptr Sysroot
self' Ptr Deployment
deployment' CInt
isPinned'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
deployment
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootDeploymentSetPinnedMethodInfo
instance (signature ~ (b -> Bool -> m ()), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b) => O.OverloadedMethod SysrootDeploymentSetPinnedMethodInfo a signature where
    overloadedMethod = sysrootDeploymentSetPinned

instance O.OverloadedMethodInfo SysrootDeploymentSetPinnedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootDeploymentSetPinned",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootDeploymentSetPinned"
        })


#endif

-- method Sysroot::deployment_unlock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Deployment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "unlocked_state"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "DeploymentUnlockedState" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Transition to this unlocked state"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_deployment_unlock" ostree_sysroot_deployment_unlock :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr OSTree.Deployment.Deployment ->     -- deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    CUInt ->                                -- unlocked_state : TInterface (Name {namespace = "OSTree", name = "DeploymentUnlockedState"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Configure the target deployment /@deployment@/ such that it
-- is writable.  There are multiple modes, essentially differing
-- in whether or not any changes persist across reboot.
-- 
-- The @OSTREE_DEPLOYMENT_UNLOCKED_HOTFIX@ state is persistent
-- across reboots.
-- 
-- /Since: 2016.4/
sysrootDeploymentUnlock ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Sysroot
    -> b
    -- ^ /@deployment@/: Deployment
    -> OSTree.Enums.DeploymentUnlockedState
    -- ^ /@unlockedState@/: Transition to this unlocked state
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootDeploymentUnlock :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsCancellable c) =>
a -> b -> DeploymentUnlockedState -> Maybe c -> m ()
sysrootDeploymentUnlock a
self b
deployment DeploymentUnlockedState
unlockedState Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Deployment
deployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
deployment
    let unlockedState' :: CUInt
unlockedState' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (DeploymentUnlockedState -> Int)
-> DeploymentUnlockedState
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DeploymentUnlockedState -> Int
forall a. Enum a => a -> Int
fromEnum) DeploymentUnlockedState
unlockedState
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr Deployment
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_deployment_unlock Ptr Sysroot
self' Ptr Deployment
deployment' CUInt
unlockedState' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
deployment
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootDeploymentUnlockMethodInfo
instance (signature ~ (b -> OSTree.Enums.DeploymentUnlockedState -> Maybe (c) -> m ()), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SysrootDeploymentUnlockMethodInfo a signature where
    overloadedMethod = sysrootDeploymentUnlock

instance O.OverloadedMethodInfo SysrootDeploymentUnlockMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootDeploymentUnlock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootDeploymentUnlock"
        })


#endif

-- method Sysroot::ensure_initialized
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_ensure_initialized" ostree_sysroot_ensure_initialized :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Ensure that /@self@/ is set up as a valid rootfs, by creating
-- \/ostree\/repo, among other things.
sysrootEnsureInitialized ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootEnsureInitialized :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> Maybe b -> m ()
sysrootEnsureInitialized a
self Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_ensure_initialized Ptr Sysroot
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootEnsureInitializedMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootEnsureInitializedMethodInfo a signature where
    overloadedMethod = sysrootEnsureInitialized

instance O.OverloadedMethodInfo SysrootEnsureInitializedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootEnsureInitialized",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootEnsureInitialized"
        })


#endif

-- method Sysroot::get_booted_deployment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "OSTree" , name = "Deployment" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_booted_deployment" ostree_sysroot_get_booted_deployment :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO (Ptr OSTree.Deployment.Deployment)

-- | /No description available in the introspection data./
sysrootGetBootedDeployment ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m (Maybe OSTree.Deployment.Deployment)
    -- ^ __Returns:__ The currently booted deployment, or 'P.Nothing' if none
sysrootGetBootedDeployment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m (Maybe Deployment)
sysrootGetBootedDeployment a
self = IO (Maybe Deployment) -> m (Maybe Deployment)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Deployment) -> m (Maybe Deployment))
-> IO (Maybe Deployment) -> m (Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Deployment
result <- Ptr Sysroot -> IO (Ptr Deployment)
ostree_sysroot_get_booted_deployment Ptr Sysroot
self'
    Maybe Deployment
maybeResult <- Ptr Deployment
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Deployment
result ((Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment))
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ \Ptr Deployment
result' -> do
        Deployment
result'' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
result'
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Deployment -> IO (Maybe Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Deployment
maybeResult

#if defined(ENABLE_OVERLOADING)
data SysrootGetBootedDeploymentMethodInfo
instance (signature ~ (m (Maybe OSTree.Deployment.Deployment)), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootGetBootedDeploymentMethodInfo a signature where
    overloadedMethod = sysrootGetBootedDeployment

instance O.OverloadedMethodInfo SysrootGetBootedDeploymentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetBootedDeployment",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetBootedDeployment"
        })


#endif

-- method Sysroot::get_bootversion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_bootversion" ostree_sysroot_get_bootversion :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO Int32

-- | /No description available in the introspection data./
sysrootGetBootversion ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -> m Int32
sysrootGetBootversion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m Int32
sysrootGetBootversion a
self = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr Sysroot -> IO Int32
ostree_sysroot_get_bootversion Ptr Sysroot
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data SysrootGetBootversionMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootGetBootversionMethodInfo a signature where
    overloadedMethod = sysrootGetBootversion

instance O.OverloadedMethodInfo SysrootGetBootversionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetBootversion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetBootversion"
        })


#endif

-- method Sysroot::get_deployment_directory
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A deployment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_deployment_directory" ostree_sysroot_get_deployment_directory :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr OSTree.Deployment.Deployment ->     -- deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    IO (Ptr Gio.File.File)

-- | /No description available in the introspection data./
sysrootGetDeploymentDirectory ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b) =>
    a
    -- ^ /@self@/: Sysroot
    -> b
    -- ^ /@deployment@/: A deployment
    -> m Gio.File.File
    -- ^ __Returns:__ Path to deployment root directory
sysrootGetDeploymentDirectory :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b) =>
a -> b -> m File
sysrootGetDeploymentDirectory a
self b
deployment = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Deployment
deployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
deployment
    Ptr File
result <- Ptr Sysroot -> Ptr Deployment -> IO (Ptr File)
ostree_sysroot_get_deployment_directory Ptr Sysroot
self' Ptr Deployment
deployment'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootGetDeploymentDirectory" Ptr File
result
    File
result' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
deployment
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data SysrootGetDeploymentDirectoryMethodInfo
instance (signature ~ (b -> m Gio.File.File), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b) => O.OverloadedMethod SysrootGetDeploymentDirectoryMethodInfo a signature where
    overloadedMethod = sysrootGetDeploymentDirectory

instance O.OverloadedMethodInfo SysrootGetDeploymentDirectoryMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetDeploymentDirectory",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetDeploymentDirectory"
        })


#endif

-- method Sysroot::get_deployment_dirpath
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A deployment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_deployment_dirpath" ostree_sysroot_get_deployment_dirpath :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr OSTree.Deployment.Deployment ->     -- deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    IO CString

-- | Note this function only returns a *relative* path - if you want
-- to access, it, you must either use fd-relative api such as @/openat()/@,
-- or concatenate it with the full 'GI.OSTree.Objects.Sysroot.sysrootGetPath'.
sysrootGetDeploymentDirpath ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b) =>
    a
    -- ^ /@self@/: Repo
    -> b
    -- ^ /@deployment@/: A deployment
    -> m T.Text
    -- ^ __Returns:__ Path to deployment root directory, relative to sysroot
sysrootGetDeploymentDirpath :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b) =>
a -> b -> m Text
sysrootGetDeploymentDirpath a
self b
deployment = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Deployment
deployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
deployment
    CString
result <- Ptr Sysroot -> Ptr Deployment -> IO CString
ostree_sysroot_get_deployment_dirpath Ptr Sysroot
self' Ptr Deployment
deployment'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootGetDeploymentDirpath" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
deployment
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data SysrootGetDeploymentDirpathMethodInfo
instance (signature ~ (b -> m T.Text), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b) => O.OverloadedMethod SysrootGetDeploymentDirpathMethodInfo a signature where
    overloadedMethod = sysrootGetDeploymentDirpath

instance O.OverloadedMethodInfo SysrootGetDeploymentDirpathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetDeploymentDirpath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetDeploymentDirpath"
        })


#endif

-- method Sysroot::get_deployments
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TPtrArray
--                  (TInterface Name { namespace = "OSTree" , name = "Deployment" }))
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_deployments" ostree_sysroot_get_deployments :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO (Ptr (GPtrArray (Ptr OSTree.Deployment.Deployment)))

-- | /No description available in the introspection data./
sysrootGetDeployments ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m [OSTree.Deployment.Deployment]
    -- ^ __Returns:__ Ordered list of deployments
sysrootGetDeployments :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m [Deployment]
sysrootGetDeployments a
self = IO [Deployment] -> m [Deployment]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Deployment] -> m [Deployment])
-> IO [Deployment] -> m [Deployment]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (GPtrArray (Ptr Deployment))
result <- Ptr Sysroot -> IO (Ptr (GPtrArray (Ptr Deployment)))
ostree_sysroot_get_deployments Ptr Sysroot
self'
    Text -> Ptr (GPtrArray (Ptr Deployment)) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootGetDeployments" Ptr (GPtrArray (Ptr Deployment))
result
    [Ptr Deployment]
result' <- Ptr (GPtrArray (Ptr Deployment)) -> IO [Ptr Deployment]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray (Ptr Deployment))
result
    [Deployment]
result'' <- (Ptr Deployment -> IO Deployment)
-> [Ptr Deployment] -> IO [Deployment]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) [Ptr Deployment]
result'
    Ptr (GPtrArray (Ptr Deployment)) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray (Ptr Deployment))
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [Deployment] -> IO [Deployment]
forall (m :: * -> *) a. Monad m => a -> m a
return [Deployment]
result''

#if defined(ENABLE_OVERLOADING)
data SysrootGetDeploymentsMethodInfo
instance (signature ~ (m [OSTree.Deployment.Deployment]), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootGetDeploymentsMethodInfo a signature where
    overloadedMethod = sysrootGetDeployments

instance O.OverloadedMethodInfo SysrootGetDeploymentsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetDeployments",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetDeployments"
        })


#endif

-- method Sysroot::get_fd
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_fd" ostree_sysroot_get_fd :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO Int32

-- | Access a file descriptor that refers to the root directory of this sysroot.
-- 'GI.OSTree.Objects.Sysroot.sysrootInitialize' (or 'GI.OSTree.Objects.Sysroot.sysrootLoad') must have been invoked
-- prior to calling this function.
sysrootGetFd ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m Int32
    -- ^ __Returns:__ A file descriptor valid for the lifetime of /@self@/
sysrootGetFd :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m Int32
sysrootGetFd a
self = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr Sysroot -> IO Int32
ostree_sysroot_get_fd Ptr Sysroot
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data SysrootGetFdMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootGetFdMethodInfo a signature where
    overloadedMethod = sysrootGetFd

instance O.OverloadedMethodInfo SysrootGetFdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetFd",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetFd"
        })


#endif

-- method Sysroot::get_merge_deployment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "osname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Operating system group"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "OSTree" , name = "Deployment" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_merge_deployment" ostree_sysroot_get_merge_deployment :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- osname : TBasicType TUTF8
    IO (Ptr OSTree.Deployment.Deployment)

-- | Find the deployment to use as a configuration merge source; this is
-- the first one in the current deployment list which matches osname.
sysrootGetMergeDeployment ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (T.Text)
    -- ^ /@osname@/: Operating system group
    -> m (Maybe OSTree.Deployment.Deployment)
    -- ^ __Returns:__ Configuration merge deployment
sysrootGetMergeDeployment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> Maybe Text -> m (Maybe Deployment)
sysrootGetMergeDeployment a
self Maybe Text
osname = IO (Maybe Deployment) -> m (Maybe Deployment)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Deployment) -> m (Maybe Deployment))
-> IO (Maybe Deployment) -> m (Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeOsname <- case Maybe Text
osname of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jOsname -> do
            CString
jOsname' <- Text -> IO CString
textToCString Text
jOsname
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOsname'
    Ptr Deployment
result <- Ptr Sysroot -> CString -> IO (Ptr Deployment)
ostree_sysroot_get_merge_deployment Ptr Sysroot
self' CString
maybeOsname
    Maybe Deployment
maybeResult <- Ptr Deployment
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Deployment
result ((Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment))
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ \Ptr Deployment
result' -> do
        Deployment
result'' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
result'
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
    Maybe Deployment -> IO (Maybe Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Deployment
maybeResult

#if defined(ENABLE_OVERLOADING)
data SysrootGetMergeDeploymentMethodInfo
instance (signature ~ (Maybe (T.Text) -> m (Maybe OSTree.Deployment.Deployment)), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootGetMergeDeploymentMethodInfo a signature where
    overloadedMethod = sysrootGetMergeDeployment

instance O.OverloadedMethodInfo SysrootGetMergeDeploymentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetMergeDeployment",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetMergeDeployment"
        })


#endif

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

foreign import ccall "ostree_sysroot_get_path" ostree_sysroot_get_path :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO (Ptr Gio.File.File)

-- | /No description available in the introspection data./
sysrootGetPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m Gio.File.File
    -- ^ __Returns:__ Path to rootfs
sysrootGetPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m File
sysrootGetPath a
self = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
result <- Ptr Sysroot -> IO (Ptr File)
ostree_sysroot_get_path Ptr Sysroot
self'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootGetPath" Ptr File
result
    File
result' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data SysrootGetPathMethodInfo
instance (signature ~ (m Gio.File.File), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootGetPathMethodInfo a signature where
    overloadedMethod = sysrootGetPath

instance O.OverloadedMethodInfo SysrootGetPathMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetPath"
        })


#endif

-- method Sysroot::get_repo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_repo"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Repository in sysroot @self"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_get_repo" ostree_sysroot_get_repo :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr (Ptr OSTree.Repo.Repo) ->           -- out_repo : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Retrieve the OSTree repository in sysroot /@self@/. The repo is guaranteed to be open
-- (see 'GI.OSTree.Objects.Repo.repoOpen').
sysrootGetRepo ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m (OSTree.Repo.Repo)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootGetRepo :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> Maybe b -> m Repo
sysrootGetRepo a
self Maybe b
cancellable = IO Repo -> m Repo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repo -> m Repo) -> IO Repo -> m Repo
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (Ptr Repo)
outRepo <- IO (Ptr (Ptr Repo))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr OSTree.Repo.Repo))
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Repo -> IO () -> IO Repo
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr (Ptr Repo) -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_get_repo Ptr Sysroot
self' Ptr (Ptr Repo)
outRepo Ptr Cancellable
maybeCancellable
        Ptr Repo
outRepo' <- Ptr (Ptr Repo) -> IO (Ptr Repo)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Repo)
outRepo
        Repo
outRepo'' <- ((ManagedPtr Repo -> Repo) -> Ptr Repo -> IO Repo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repo -> Repo
OSTree.Repo.Repo) Ptr Repo
outRepo'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (Ptr Repo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Repo)
outRepo
        Repo -> IO Repo
forall (m :: * -> *) a. Monad m => a -> m a
return Repo
outRepo''
     ) (do
        Ptr (Ptr Repo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Repo)
outRepo
     )

#if defined(ENABLE_OVERLOADING)
data SysrootGetRepoMethodInfo
instance (signature ~ (Maybe (b) -> m (OSTree.Repo.Repo)), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootGetRepoMethodInfo a signature where
    overloadedMethod = sysrootGetRepo

instance O.OverloadedMethodInfo SysrootGetRepoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetRepo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetRepo"
        })


#endif

-- method Sysroot::get_staged_deployment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "OSTree" , name = "Deployment" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_staged_deployment" ostree_sysroot_get_staged_deployment :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO (Ptr OSTree.Deployment.Deployment)

-- | /No description available in the introspection data./
-- 
-- /Since: 2018.5/
sysrootGetStagedDeployment ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m (Maybe OSTree.Deployment.Deployment)
    -- ^ __Returns:__ The currently staged deployment, or 'P.Nothing' if none
sysrootGetStagedDeployment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m (Maybe Deployment)
sysrootGetStagedDeployment a
self = IO (Maybe Deployment) -> m (Maybe Deployment)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Deployment) -> m (Maybe Deployment))
-> IO (Maybe Deployment) -> m (Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Deployment
result <- Ptr Sysroot -> IO (Ptr Deployment)
ostree_sysroot_get_staged_deployment Ptr Sysroot
self'
    Maybe Deployment
maybeResult <- Ptr Deployment
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Deployment
result ((Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment))
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ \Ptr Deployment
result' -> do
        Deployment
result'' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
result'
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Deployment -> IO (Maybe Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Deployment
maybeResult

#if defined(ENABLE_OVERLOADING)
data SysrootGetStagedDeploymentMethodInfo
instance (signature ~ (m (Maybe OSTree.Deployment.Deployment)), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootGetStagedDeploymentMethodInfo a signature where
    overloadedMethod = sysrootGetStagedDeployment

instance O.OverloadedMethodInfo SysrootGetStagedDeploymentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetStagedDeployment",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetStagedDeployment"
        })


#endif

-- method Sysroot::get_subbootversion
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_get_subbootversion" ostree_sysroot_get_subbootversion :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO Int32

-- | /No description available in the introspection data./
sysrootGetSubbootversion ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -> m Int32
sysrootGetSubbootversion :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m Int32
sysrootGetSubbootversion a
self = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr Sysroot -> IO Int32
ostree_sysroot_get_subbootversion Ptr Sysroot
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data SysrootGetSubbootversionMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootGetSubbootversionMethodInfo a signature where
    overloadedMethod = sysrootGetSubbootversion

instance O.OverloadedMethodInfo SysrootGetSubbootversionMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootGetSubbootversion",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootGetSubbootversion"
        })


#endif

-- method Sysroot::init_osname
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "osname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name group of operating system checkouts"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_init_osname" ostree_sysroot_init_osname :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- osname : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Initialize the directory structure for an \"osname\", which is a
-- group of operating system deployments, with a shared @\/var@.  One
-- is required for generating a deployment.
-- 
-- /Since: 2016.4/
sysrootInitOsname ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> T.Text
    -- ^ /@osname@/: Name group of operating system checkouts
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootInitOsname :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> Text -> Maybe b -> m ()
sysrootInitOsname a
self Text
osname Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
osname' <- Text -> IO CString
textToCString Text
osname
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_init_osname Ptr Sysroot
self' CString
osname' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
osname'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
osname'
     )

#if defined(ENABLE_OVERLOADING)
data SysrootInitOsnameMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootInitOsnameMethodInfo a signature where
    overloadedMethod = sysrootInitOsname

instance O.OverloadedMethodInfo SysrootInitOsnameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootInitOsname",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootInitOsname"
        })


#endif

-- method Sysroot::initialize
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_initialize" ostree_sysroot_initialize :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Subset of 'GI.OSTree.Objects.Sysroot.sysrootLoad'; performs basic initialization. Notably, one
-- can invoke @ostree_sysroot_get_fd()@ after calling this function.
-- 
-- It is not necessary to call this function if 'GI.OSTree.Objects.Sysroot.sysrootLoad' is
-- invoked.
-- 
-- /Since: 2020.1/
sysrootInitialize ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: sysroot
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootInitialize :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m ()
sysrootInitialize a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_initialize Ptr Sysroot
self'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootInitializeMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootInitializeMethodInfo a signature where
    overloadedMethod = sysrootInitialize

instance O.OverloadedMethodInfo SysrootInitializeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootInitialize",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootInitialize"
        })


#endif

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

foreign import ccall "ostree_sysroot_is_booted" ostree_sysroot_is_booted :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO CInt

-- | Can only be invoked after @ostree_sysroot_initialize()@.
-- 
-- /Since: 2020.1/
sysrootIsBooted ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m Bool
    -- ^ __Returns:__ 'P.True' iff the sysroot points to a booted deployment
sysrootIsBooted :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m Bool
sysrootIsBooted a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Sysroot -> IO CInt
ostree_sysroot_is_booted Ptr Sysroot
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SysrootIsBootedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootIsBootedMethodInfo a signature where
    overloadedMethod = sysrootIsBooted

instance O.OverloadedMethodInfo SysrootIsBootedMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootIsBooted",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootIsBooted"
        })


#endif

-- method Sysroot::load
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_load" ostree_sysroot_load :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Load deployment list, bootversion, and subbootversion from the
-- rootfs /@self@/.
sysrootLoad ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootLoad :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> Maybe b -> m ()
sysrootLoad a
self Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_load Ptr Sysroot
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootLoadMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootLoadMethodInfo a signature where
    overloadedMethod = sysrootLoad

instance O.OverloadedMethodInfo SysrootLoadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootLoad",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootLoad"
        })


#endif

-- XXX Could not generate method Sysroot::load_if_changed
-- Not implemented: Don't know how to allocate "out_changed" of type TBasicType TBoolean
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data SysrootLoadIfChangedMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "loadIfChanged" Sysroot) => O.OverloadedMethod SysrootLoadIfChangedMethodInfo o p where
    overloadedMethod = undefined

instance (o ~ O.UnsupportedMethodError "loadIfChanged" Sysroot) => O.OverloadedMethodInfo SysrootLoadIfChangedMethodInfo o where
    overloadedMethodInfo = undefined

#endif

-- method Sysroot::lock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_lock" ostree_sysroot_lock :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Acquire an exclusive multi-process write lock for /@self@/.  This call
-- blocks until the lock has been acquired.  The lock is not
-- reentrant.
-- 
-- Release the lock with 'GI.OSTree.Objects.Sysroot.sysrootUnlock'.  The lock will also
-- be released if /@self@/ is deallocated.
sysrootLock ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Self
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootLock :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m ()
sysrootLock a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_lock Ptr Sysroot
self'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootLockMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootLockMethodInfo a signature where
    overloadedMethod = sysrootLock

instance O.OverloadedMethodInfo SysrootLockMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootLock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootLock"
        })


#endif

-- method Sysroot::lock_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_lock_async" ostree_sysroot_lock_async :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | An asynchronous version of 'GI.OSTree.Objects.Sysroot.sysrootLock'.
sysrootLockAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Self
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: Callback
    -> m ()
sysrootLockAsync :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
sysrootLockAsync a
self Maybe b
cancellable Maybe AsyncReadyCallback
callback = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Maybe AsyncReadyCallback
Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Sysroot
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ostree_sysroot_lock_async Ptr Sysroot
self' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SysrootLockAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootLockAsyncMethodInfo a signature where
    overloadedMethod = sysrootLockAsync

instance O.OverloadedMethodInfo SysrootLockAsyncMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootLockAsync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootLockAsync"
        })


#endif

-- method Sysroot::lock_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_lock_finish" ostree_sysroot_lock_finish :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Call when 'GI.OSTree.Objects.Sysroot.sysrootLockAsync' is ready.
sysrootLockFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: Self
    -> b
    -- ^ /@result@/: Result
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootLockFinish :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsAsyncResult b) =>
a -> b -> m ()
sysrootLockFinish a
self b
result_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_lock_finish Ptr Sysroot
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

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

instance O.OverloadedMethodInfo SysrootLockFinishMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootLockFinish",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootLockFinish"
        })


#endif

-- method Sysroot::origin_new_from_refspec
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refspec"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A refspec" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "KeyFile" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_origin_new_from_refspec" ostree_sysroot_origin_new_from_refspec :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- refspec : TBasicType TUTF8
    IO (Ptr GLib.KeyFile.KeyFile)

-- | /No description available in the introspection data./
sysrootOriginNewFromRefspec ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> T.Text
    -- ^ /@refspec@/: A refspec
    -> m GLib.KeyFile.KeyFile
    -- ^ __Returns:__ A new config file which sets /@refspec@/ as an origin
sysrootOriginNewFromRefspec :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> Text -> m KeyFile
sysrootOriginNewFromRefspec a
self Text
refspec = IO KeyFile -> m KeyFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO KeyFile -> m KeyFile) -> IO KeyFile -> m KeyFile
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
refspec' <- Text -> IO CString
textToCString Text
refspec
    Ptr KeyFile
result <- Ptr Sysroot -> CString -> IO (Ptr KeyFile)
ostree_sysroot_origin_new_from_refspec Ptr Sysroot
self' CString
refspec'
    Text -> Ptr KeyFile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootOriginNewFromRefspec" Ptr KeyFile
result
    KeyFile
result' <- ((ManagedPtr KeyFile -> KeyFile) -> Ptr KeyFile -> IO KeyFile
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr KeyFile -> KeyFile
GLib.KeyFile.KeyFile) Ptr KeyFile
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
refspec'
    KeyFile -> IO KeyFile
forall (m :: * -> *) a. Monad m => a -> m a
return KeyFile
result'

#if defined(ENABLE_OVERLOADING)
data SysrootOriginNewFromRefspecMethodInfo
instance (signature ~ (T.Text -> m GLib.KeyFile.KeyFile), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootOriginNewFromRefspecMethodInfo a signature where
    overloadedMethod = sysrootOriginNewFromRefspec

instance O.OverloadedMethodInfo SysrootOriginNewFromRefspecMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootOriginNewFromRefspec",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootOriginNewFromRefspec"
        })


#endif

-- method Sysroot::prepare_cleanup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_prepare_cleanup" ostree_sysroot_prepare_cleanup :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Like 'GI.OSTree.Objects.Sysroot.sysrootCleanup' in that it cleans up incomplete deployments
-- and old boot versions, but does NOT prune the repository.
sysrootPrepareCleanup ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootPrepareCleanup :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> Maybe b -> m ()
sysrootPrepareCleanup a
self Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_prepare_cleanup Ptr Sysroot
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootPrepareCleanupMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootPrepareCleanupMethodInfo a signature where
    overloadedMethod = sysrootPrepareCleanup

instance O.OverloadedMethodInfo SysrootPrepareCleanupMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootPrepareCleanup",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootPrepareCleanup"
        })


#endif

-- method Sysroot::query_deployments_for
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "osname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "\"stateroot\" name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_pending"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The pending deployment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_rollback"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The rollback deployment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_query_deployments_for" ostree_sysroot_query_deployments_for :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- osname : TBasicType TUTF8
    Ptr (Ptr OSTree.Deployment.Deployment) -> -- out_pending : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr (Ptr OSTree.Deployment.Deployment) -> -- out_rollback : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    IO ()

-- | Find the pending and rollback deployments for /@osname@/. Pass 'P.Nothing' for /@osname@/
-- to use the booted deployment\'s osname. By default, pending deployment is the
-- first deployment in the order that matches /@osname@/, and /@rollback@/ will be the
-- next one after the booted deployment, or the deployment after the pending if
-- we\'re not looking at the booted deployment.
-- 
-- /Since: 2017.7/
sysrootQueryDeploymentsFor ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (T.Text)
    -- ^ /@osname@/: \"stateroot\" name
    -> m ((Maybe OSTree.Deployment.Deployment, Maybe OSTree.Deployment.Deployment))
sysrootQueryDeploymentsFor :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> Maybe Text -> m (Maybe Deployment, Maybe Deployment)
sysrootQueryDeploymentsFor a
self Maybe Text
osname = IO (Maybe Deployment, Maybe Deployment)
-> m (Maybe Deployment, Maybe Deployment)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Deployment, Maybe Deployment)
 -> m (Maybe Deployment, Maybe Deployment))
-> IO (Maybe Deployment, Maybe Deployment)
-> m (Maybe Deployment, Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeOsname <- case Maybe Text
osname of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jOsname -> do
            CString
jOsname' <- Text -> IO CString
textToCString Text
jOsname
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOsname'
    Ptr (Ptr Deployment)
outPending <- IO (Ptr (Ptr Deployment))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr OSTree.Deployment.Deployment))
    Ptr (Ptr Deployment)
outRollback <- IO (Ptr (Ptr Deployment))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr OSTree.Deployment.Deployment))
    Ptr Sysroot
-> CString -> Ptr (Ptr Deployment) -> Ptr (Ptr Deployment) -> IO ()
ostree_sysroot_query_deployments_for Ptr Sysroot
self' CString
maybeOsname Ptr (Ptr Deployment)
outPending Ptr (Ptr Deployment)
outRollback
    Ptr Deployment
outPending' <- Ptr (Ptr Deployment) -> IO (Ptr Deployment)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Deployment)
outPending
    Maybe Deployment
maybeOutPending' <- Ptr Deployment
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Deployment
outPending' ((Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment))
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ \Ptr Deployment
outPending'' -> do
        Deployment
outPending''' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
outPending''
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
outPending'''
    Ptr Deployment
outRollback' <- Ptr (Ptr Deployment) -> IO (Ptr Deployment)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Deployment)
outRollback
    Maybe Deployment
maybeOutRollback' <- Ptr Deployment
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Deployment
outRollback' ((Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment))
-> (Ptr Deployment -> IO Deployment) -> IO (Maybe Deployment)
forall a b. (a -> b) -> a -> b
$ \Ptr Deployment
outRollback'' -> do
        Deployment
outRollback''' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
outRollback''
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
outRollback'''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
    Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outPending
    Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outRollback
    (Maybe Deployment, Maybe Deployment)
-> IO (Maybe Deployment, Maybe Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Deployment
maybeOutPending', Maybe Deployment
maybeOutRollback')

#if defined(ENABLE_OVERLOADING)
data SysrootQueryDeploymentsForMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ((Maybe OSTree.Deployment.Deployment, Maybe OSTree.Deployment.Deployment))), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootQueryDeploymentsForMethodInfo a signature where
    overloadedMethod = sysrootQueryDeploymentsFor

instance O.OverloadedMethodInfo SysrootQueryDeploymentsForMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootQueryDeploymentsFor",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootQueryDeploymentsFor"
        })


#endif

-- method Sysroot::repo
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "OSTree" , name = "Repo" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_repo" ostree_sysroot_repo :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO (Ptr OSTree.Repo.Repo)

-- | This function is a variant of 'GI.OSTree.Objects.Sysroot.sysrootGetRepo' that cannot fail, and
-- returns a cached repository. Can only be called after 'GI.OSTree.Objects.Sysroot.sysrootInitialize'
-- or 'GI.OSTree.Objects.Sysroot.sysrootLoad' has been invoked successfully.
-- 
-- /Since: 2017.7/
sysrootRepo ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m OSTree.Repo.Repo
    -- ^ __Returns:__ The OSTree repository in sysroot /@self@/.
sysrootRepo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m Repo
sysrootRepo a
self = IO Repo -> m Repo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repo -> m Repo) -> IO Repo -> m Repo
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Repo
result <- Ptr Sysroot -> IO (Ptr Repo)
ostree_sysroot_repo Ptr Sysroot
self'
    Text -> Ptr Repo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootRepo" Ptr Repo
result
    Repo
result' <- ((ManagedPtr Repo -> Repo) -> Ptr Repo -> IO Repo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Repo -> Repo
OSTree.Repo.Repo) Ptr Repo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Repo -> IO Repo
forall (m :: * -> *) a. Monad m => a -> m a
return Repo
result'

#if defined(ENABLE_OVERLOADING)
data SysrootRepoMethodInfo
instance (signature ~ (m OSTree.Repo.Repo), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootRepoMethodInfo a signature where
    overloadedMethod = sysrootRepo

instance O.OverloadedMethodInfo SysrootRepoMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootRepo",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootRepo"
        })


#endif

-- method Sysroot::require_booted_deployment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "OSTree" , name = "Deployment" })
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_require_booted_deployment" ostree_sysroot_require_booted_deployment :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr OSTree.Deployment.Deployment)

-- | Find the booted deployment, or return an error if not booted via OSTree.
-- 
-- /Since: 2021.1/
sysrootRequireBootedDeployment ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m OSTree.Deployment.Deployment
    -- ^ __Returns:__ The currently booted deployment, or an error /(Can throw 'Data.GI.Base.GError.GError')/
sysrootRequireBootedDeployment :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m Deployment
sysrootRequireBootedDeployment a
self = IO Deployment -> m Deployment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Deployment -> m Deployment) -> IO Deployment -> m Deployment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    IO Deployment -> IO () -> IO Deployment
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Deployment
result <- (Ptr (Ptr GError) -> IO (Ptr Deployment)) -> IO (Ptr Deployment)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Deployment)) -> IO (Ptr Deployment))
-> (Ptr (Ptr GError) -> IO (Ptr Deployment)) -> IO (Ptr Deployment)
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr (Ptr GError) -> IO (Ptr Deployment)
ostree_sysroot_require_booted_deployment Ptr Sysroot
self'
        Text -> Ptr Deployment -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootRequireBootedDeployment" Ptr Deployment
result
        Deployment
result' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootRequireBootedDeploymentMethodInfo
instance (signature ~ (m OSTree.Deployment.Deployment), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootRequireBootedDeploymentMethodInfo a signature where
    overloadedMethod = sysrootRequireBootedDeployment

instance O.OverloadedMethodInfo SysrootRequireBootedDeploymentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootRequireBootedDeployment",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootRequireBootedDeployment"
        })


#endif

-- method Sysroot::set_mount_namespace_in_use
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_set_mount_namespace_in_use" ostree_sysroot_set_mount_namespace_in_use :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO ()

-- | If this function is invoked, then libostree will assume that
-- a private Linux mount namespace has been created by the process.
-- The primary use case for this is to have e.g. \/sysroot mounted
-- read-only by default.
-- 
-- If this function has been called, then when a function which requires
-- writable access is invoked, libostree will automatically remount as writable
-- any mount points on which it operates.  This currently is just @\/sysroot@ and
-- @\/boot@.
-- 
-- If you invoke this function, it must be before 'GI.OSTree.Objects.Sysroot.sysrootLoad'; it may
-- be invoked before or after 'GI.OSTree.Objects.Sysroot.sysrootInitialize'.
-- 
-- /Since: 2020.1/
sysrootSetMountNamespaceInUse ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -> m ()
sysrootSetMountNamespaceInUse :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m ()
sysrootSetMountNamespaceInUse a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Sysroot -> IO ()
ostree_sysroot_set_mount_namespace_in_use Ptr Sysroot
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SysrootSetMountNamespaceInUseMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootSetMountNamespaceInUseMethodInfo a signature where
    overloadedMethod = sysrootSetMountNamespaceInUse

instance O.OverloadedMethodInfo SysrootSetMountNamespaceInUseMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootSetMountNamespaceInUse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootSetMountNamespaceInUse"
        })


#endif

-- method Sysroot::simple_write_deployment
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sysroot"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "osname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "OS name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Prepend this deployment to the list"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "merge_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Use this deployment for configuration merge"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "OSTree"
--                   , name = "SysrootSimpleWriteDeploymentFlags"
--                   }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Flags controlling behavior"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_simple_write_deployment" ostree_sysroot_simple_write_deployment :: 
    Ptr Sysroot ->                          -- sysroot : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- osname : TBasicType TUTF8
    Ptr OSTree.Deployment.Deployment ->     -- new_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr OSTree.Deployment.Deployment ->     -- merge_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "OSTree", name = "SysrootSimpleWriteDeploymentFlags"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Prepend /@newDeployment@/ to the list of deployments, commit, and
-- cleanup.  By default, all other deployments for the given /@osname@/
-- except the merge deployment and the booted deployment will be
-- garbage collected.
-- 
-- If 'GI.OSTree.Flags.SysrootSimpleWriteDeploymentFlagsRetain' is
-- specified, then all current deployments will be kept.
-- 
-- If 'GI.OSTree.Flags.SysrootSimpleWriteDeploymentFlagsRetainPending' is
-- specified, then pending deployments will be kept.
-- 
-- If 'GI.OSTree.Flags.SysrootSimpleWriteDeploymentFlagsRetainRollback' is
-- specified, then rollback deployments will be kept.
-- 
-- If 'GI.OSTree.Flags.SysrootSimpleWriteDeploymentFlagsNotDefault' is
-- specified, then instead of prepending, the new deployment will be
-- added right after the booted or merge deployment, instead of first.
-- 
-- If 'GI.OSTree.Flags.SysrootSimpleWriteDeploymentFlagsNoClean' is
-- specified, then no cleanup will be performed after adding the
-- deployment. Make sure to call 'GI.OSTree.Objects.Sysroot.sysrootCleanup' sometime
-- later, instead.
sysrootSimpleWriteDeployment ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, OSTree.Deployment.IsDeployment c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@sysroot@/: Sysroot
    -> Maybe (T.Text)
    -- ^ /@osname@/: OS name
    -> b
    -- ^ /@newDeployment@/: Prepend this deployment to the list
    -> Maybe (c)
    -- ^ /@mergeDeployment@/: Use this deployment for configuration merge
    -> [OSTree.Flags.SysrootSimpleWriteDeploymentFlags]
    -- ^ /@flags@/: Flags controlling behavior
    -> Maybe (d)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootSimpleWriteDeployment :: forall (m :: * -> *) a b c d.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsDeployment c, IsCancellable d) =>
a
-> Maybe Text
-> b
-> Maybe c
-> [SysrootSimpleWriteDeploymentFlags]
-> Maybe d
-> m ()
sysrootSimpleWriteDeployment a
sysroot Maybe Text
osname b
newDeployment Maybe c
mergeDeployment [SysrootSimpleWriteDeploymentFlags]
flags Maybe d
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
sysroot' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sysroot
    CString
maybeOsname <- case Maybe Text
osname of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jOsname -> do
            CString
jOsname' <- Text -> IO CString
textToCString Text
jOsname
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOsname'
    Ptr Deployment
newDeployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
newDeployment
    Ptr Deployment
maybeMergeDeployment <- case Maybe c
mergeDeployment of
        Maybe c
Nothing -> Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
forall a. Ptr a
nullPtr
        Just c
jMergeDeployment -> do
            Ptr Deployment
jMergeDeployment' <- c -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jMergeDeployment
            Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
jMergeDeployment'
    let flags' :: CUInt
flags' = [SysrootSimpleWriteDeploymentFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [SysrootSimpleWriteDeploymentFlags]
flags
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Maybe d
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> CString
-> Ptr Deployment
-> Ptr Deployment
-> CUInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_simple_write_deployment Ptr Sysroot
sysroot' CString
maybeOsname Ptr Deployment
newDeployment' Ptr Deployment
maybeMergeDeployment CUInt
flags' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sysroot
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
newDeployment
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
mergeDeployment c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
     )

#if defined(ENABLE_OVERLOADING)
data SysrootSimpleWriteDeploymentMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> Maybe (c) -> [OSTree.Flags.SysrootSimpleWriteDeploymentFlags] -> Maybe (d) -> m ()), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, OSTree.Deployment.IsDeployment c, Gio.Cancellable.IsCancellable d) => O.OverloadedMethod SysrootSimpleWriteDeploymentMethodInfo a signature where
    overloadedMethod = sysrootSimpleWriteDeployment

instance O.OverloadedMethodInfo SysrootSimpleWriteDeploymentMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootSimpleWriteDeployment",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootSimpleWriteDeployment"
        })


#endif

-- method Sysroot::stage_overlay_initrd
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "fd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "File descriptor to overlay initrd"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Overlay initrd checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_stage_overlay_initrd" ostree_sysroot_stage_overlay_initrd :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Int32 ->                                -- fd : TBasicType TInt
    Ptr CString ->                          -- out_checksum : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Stage an overlay initrd to be used in an upcoming deployment. Returns a checksum which
-- can be passed to 'GI.OSTree.Objects.Sysroot.sysrootDeployTreeWithOptions' or
-- 'GI.OSTree.Objects.Sysroot.sysrootStageTreeWithOptions' via the @overlay_initrds@ array option.
-- 
-- /Since: 2020.7/
sysrootStageOverlayInitrd ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> Int32
    -- ^ /@fd@/: File descriptor to overlay initrd
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootStageOverlayInitrd :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> Int32 -> Maybe b -> m Text
sysrootStageOverlayInitrd a
self Int32
fd Maybe b
cancellable = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
outChecksum <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Text -> IO () -> IO Text
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Int32
-> Ptr CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_stage_overlay_initrd Ptr Sysroot
self' Int32
fd Ptr CString
outChecksum Ptr Cancellable
maybeCancellable
        CString
outChecksum' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outChecksum
        Text
outChecksum'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outChecksum'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outChecksum'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outChecksum
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outChecksum''
     ) (do
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outChecksum
     )

#if defined(ENABLE_OVERLOADING)
data SysrootStageOverlayInitrdMethodInfo
instance (signature ~ (Int32 -> Maybe (b) -> m (T.Text)), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootStageOverlayInitrdMethodInfo a signature where
    overloadedMethod = sysrootStageOverlayInitrd

instance O.OverloadedMethodInfo SysrootStageOverlayInitrdMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootStageOverlayInitrd",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootStageOverlayInitrd"
        })


#endif

-- method Sysroot::stage_tree
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "osname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "osname to use for merge deployment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "revision"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Origin to use for upgrades"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "merge_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Use this deployment for merge path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "override_kernel_argv"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Use these as kernel arguments; if %NULL, inherit options from provided_merge_deployment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_new_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new deployment path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_stage_tree" ostree_sysroot_stage_tree :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- osname : TBasicType TUTF8
    CString ->                              -- revision : TBasicType TUTF8
    Ptr GLib.KeyFile.KeyFile ->             -- origin : TInterface (Name {namespace = "GLib", name = "KeyFile"})
    Ptr OSTree.Deployment.Deployment ->     -- merge_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr CString ->                          -- override_kernel_argv : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr (Ptr OSTree.Deployment.Deployment) -> -- out_new_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Older version of 'GI.OSTree.Objects.Sysroot.sysrootStageTreeWithOptions'.
-- 
-- /Since: 2018.5/
sysrootStageTree ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (T.Text)
    -- ^ /@osname@/: osname to use for merge deployment
    -> T.Text
    -- ^ /@revision@/: Checksum to add
    -> Maybe (GLib.KeyFile.KeyFile)
    -- ^ /@origin@/: Origin to use for upgrades
    -> Maybe (b)
    -- ^ /@mergeDeployment@/: Use this deployment for merge path
    -> Maybe ([T.Text])
    -- ^ /@overrideKernelArgv@/: Use these as kernel arguments; if 'P.Nothing', inherit options from provided_merge_deployment
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m (OSTree.Deployment.Deployment)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootStageTree :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsCancellable c) =>
a
-> Maybe Text
-> Text
-> Maybe KeyFile
-> Maybe b
-> Maybe [Text]
-> Maybe c
-> m Deployment
sysrootStageTree a
self Maybe Text
osname Text
revision Maybe KeyFile
origin Maybe b
mergeDeployment Maybe [Text]
overrideKernelArgv Maybe c
cancellable = IO Deployment -> m Deployment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Deployment -> m Deployment) -> IO Deployment -> m Deployment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeOsname <- case Maybe Text
osname of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jOsname -> do
            CString
jOsname' <- Text -> IO CString
textToCString Text
jOsname
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOsname'
    CString
revision' <- Text -> IO CString
textToCString Text
revision
    Ptr KeyFile
maybeOrigin <- case Maybe KeyFile
origin of
        Maybe KeyFile
Nothing -> Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
forall a. Ptr a
nullPtr
        Just KeyFile
jOrigin -> do
            Ptr KeyFile
jOrigin' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
jOrigin
            Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
jOrigin'
    Ptr Deployment
maybeMergeDeployment <- case Maybe b
mergeDeployment of
        Maybe b
Nothing -> Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
forall a. Ptr a
nullPtr
        Just b
jMergeDeployment -> do
            Ptr Deployment
jMergeDeployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMergeDeployment
            Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
jMergeDeployment'
    Ptr CString
maybeOverrideKernelArgv <- case Maybe [Text]
overrideKernelArgv of
        Maybe [Text]
Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just [Text]
jOverrideKernelArgv -> do
            Ptr CString
jOverrideKernelArgv' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jOverrideKernelArgv
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jOverrideKernelArgv'
    Ptr (Ptr Deployment)
outNewDeployment <- IO (Ptr (Ptr Deployment))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr OSTree.Deployment.Deployment))
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Deployment -> IO () -> IO Deployment
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> CString
-> CString
-> Ptr KeyFile
-> Ptr Deployment
-> Ptr CString
-> Ptr (Ptr Deployment)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_stage_tree Ptr Sysroot
self' CString
maybeOsname CString
revision' Ptr KeyFile
maybeOrigin Ptr Deployment
maybeMergeDeployment Ptr CString
maybeOverrideKernelArgv Ptr (Ptr Deployment)
outNewDeployment Ptr Cancellable
maybeCancellable
        Ptr Deployment
outNewDeployment' <- Ptr (Ptr Deployment) -> IO (Ptr Deployment)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Deployment)
outNewDeployment
        Deployment
outNewDeployment'' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
outNewDeployment'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe KeyFile -> (KeyFile -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe KeyFile
origin KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mergeDeployment b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
revision'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeOverrideKernelArgv
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeOverrideKernelArgv
        Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outNewDeployment
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
outNewDeployment''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
revision'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeOverrideKernelArgv
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeOverrideKernelArgv
        Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outNewDeployment
     )

#if defined(ENABLE_OVERLOADING)
data SysrootStageTreeMethodInfo
instance (signature ~ (Maybe (T.Text) -> T.Text -> Maybe (GLib.KeyFile.KeyFile) -> Maybe (b) -> Maybe ([T.Text]) -> Maybe (c) -> m (OSTree.Deployment.Deployment)), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SysrootStageTreeMethodInfo a signature where
    overloadedMethod = sysrootStageTree

instance O.OverloadedMethodInfo SysrootStageTreeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootStageTree",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootStageTree"
        })


#endif

-- method Sysroot::stage_tree_with_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "osname"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "osname to use for merge deployment"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "revision"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum to add" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "origin"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Origin to use for upgrades"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "merge_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Use this deployment for merge path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "opts"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "SysrootDeployTreeOpts" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_new_deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The new deployment path"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_stage_tree_with_options" ostree_sysroot_stage_tree_with_options :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    CString ->                              -- osname : TBasicType TUTF8
    CString ->                              -- revision : TBasicType TUTF8
    Ptr GLib.KeyFile.KeyFile ->             -- origin : TInterface (Name {namespace = "GLib", name = "KeyFile"})
    Ptr OSTree.Deployment.Deployment ->     -- merge_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr OSTree.SysrootDeployTreeOpts.SysrootDeployTreeOpts -> -- opts : TInterface (Name {namespace = "OSTree", name = "SysrootDeployTreeOpts"})
    Ptr (Ptr OSTree.Deployment.Deployment) -> -- out_new_deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Like 'GI.OSTree.Objects.Sysroot.sysrootDeployTree', but \"finalization\" only occurs at OS
-- shutdown time.
-- 
-- /Since: 2020.7/
sysrootStageTreeWithOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Sysroot
    -> Maybe (T.Text)
    -- ^ /@osname@/: osname to use for merge deployment
    -> T.Text
    -- ^ /@revision@/: Checksum to add
    -> Maybe (GLib.KeyFile.KeyFile)
    -- ^ /@origin@/: Origin to use for upgrades
    -> Maybe (b)
    -- ^ /@mergeDeployment@/: Use this deployment for merge path
    -> OSTree.SysrootDeployTreeOpts.SysrootDeployTreeOpts
    -- ^ /@opts@/: Options
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m (OSTree.Deployment.Deployment)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootStageTreeWithOptions :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsCancellable c) =>
a
-> Maybe Text
-> Text
-> Maybe KeyFile
-> Maybe b
-> SysrootDeployTreeOpts
-> Maybe c
-> m Deployment
sysrootStageTreeWithOptions a
self Maybe Text
osname Text
revision Maybe KeyFile
origin Maybe b
mergeDeployment SysrootDeployTreeOpts
opts Maybe c
cancellable = IO Deployment -> m Deployment
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Deployment -> m Deployment) -> IO Deployment -> m Deployment
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeOsname <- case Maybe Text
osname of
        Maybe Text
Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just Text
jOsname -> do
            CString
jOsname' <- Text -> IO CString
textToCString Text
jOsname
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jOsname'
    CString
revision' <- Text -> IO CString
textToCString Text
revision
    Ptr KeyFile
maybeOrigin <- case Maybe KeyFile
origin of
        Maybe KeyFile
Nothing -> Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
forall a. Ptr a
nullPtr
        Just KeyFile
jOrigin -> do
            Ptr KeyFile
jOrigin' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
jOrigin
            Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
jOrigin'
    Ptr Deployment
maybeMergeDeployment <- case Maybe b
mergeDeployment of
        Maybe b
Nothing -> Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
forall a. Ptr a
nullPtr
        Just b
jMergeDeployment -> do
            Ptr Deployment
jMergeDeployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jMergeDeployment
            Ptr Deployment -> IO (Ptr Deployment)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Deployment
jMergeDeployment'
    Ptr SysrootDeployTreeOpts
opts' <- SysrootDeployTreeOpts -> IO (Ptr SysrootDeployTreeOpts)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SysrootDeployTreeOpts
opts
    Ptr (Ptr Deployment)
outNewDeployment <- IO (Ptr (Ptr Deployment))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr OSTree.Deployment.Deployment))
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Deployment -> IO () -> IO Deployment
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> CString
-> CString
-> Ptr KeyFile
-> Ptr Deployment
-> Ptr SysrootDeployTreeOpts
-> Ptr (Ptr Deployment)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_stage_tree_with_options Ptr Sysroot
self' CString
maybeOsname CString
revision' Ptr KeyFile
maybeOrigin Ptr Deployment
maybeMergeDeployment Ptr SysrootDeployTreeOpts
opts' Ptr (Ptr Deployment)
outNewDeployment Ptr Cancellable
maybeCancellable
        Ptr Deployment
outNewDeployment' <- Ptr (Ptr Deployment) -> IO (Ptr Deployment)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Deployment)
outNewDeployment
        Deployment
outNewDeployment'' <- ((ManagedPtr Deployment -> Deployment)
-> Ptr Deployment -> IO Deployment
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Deployment -> Deployment
OSTree.Deployment.Deployment) Ptr Deployment
outNewDeployment'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe KeyFile -> (KeyFile -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe KeyFile
origin KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
mergeDeployment b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        SysrootDeployTreeOpts -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SysrootDeployTreeOpts
opts
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
revision'
        Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outNewDeployment
        Deployment -> IO Deployment
forall (m :: * -> *) a. Monad m => a -> m a
return Deployment
outNewDeployment''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeOsname
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
revision'
        Ptr (Ptr Deployment) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Deployment)
outNewDeployment
     )

#if defined(ENABLE_OVERLOADING)
data SysrootStageTreeWithOptionsMethodInfo
instance (signature ~ (Maybe (T.Text) -> T.Text -> Maybe (GLib.KeyFile.KeyFile) -> Maybe (b) -> OSTree.SysrootDeployTreeOpts.SysrootDeployTreeOpts -> Maybe (c) -> m (OSTree.Deployment.Deployment)), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SysrootStageTreeWithOptionsMethodInfo a signature where
    overloadedMethod = sysrootStageTreeWithOptions

instance O.OverloadedMethodInfo SysrootStageTreeWithOptionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootStageTreeWithOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootStageTreeWithOptions"
        })


#endif

-- method Sysroot::try_lock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_acquired"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether or not the lock has been acquired"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_try_lock" ostree_sysroot_try_lock :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr CInt ->                             -- out_acquired : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Try to acquire an exclusive multi-process write lock for /@self@/.  If
-- another process holds the lock, this function will return
-- immediately, setting /@outAcquired@/ to 'P.False', and returning 'P.True'
-- (and no error).
-- 
-- Release the lock with 'GI.OSTree.Objects.Sysroot.sysrootUnlock'.  The lock will also
-- be released if /@self@/ is deallocated.
sysrootTryLock ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Self
    -> m (Bool)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootTryLock :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m Bool
sysrootTryLock a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CInt
outAcquired <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO Bool -> IO () -> IO Bool
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot -> Ptr CInt -> Ptr (Ptr GError) -> IO CInt
ostree_sysroot_try_lock Ptr Sysroot
self' Ptr CInt
outAcquired
        CInt
outAcquired' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outAcquired
        let outAcquired'' :: Bool
outAcquired'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
outAcquired'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outAcquired
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
outAcquired''
     ) (do
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outAcquired
     )

#if defined(ENABLE_OVERLOADING)
data SysrootTryLockMethodInfo
instance (signature ~ (m (Bool)), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootTryLockMethodInfo a signature where
    overloadedMethod = sysrootTryLock

instance O.OverloadedMethodInfo SysrootTryLockMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootTryLock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootTryLock"
        })


#endif

-- method Sysroot::unload
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_unload" ostree_sysroot_unload :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO ()

-- | Release any resources such as file descriptors referring to the
-- root directory of this sysroot.  Normally, those resources are
-- cleared by finalization, but in garbage collected languages that
-- may not be predictable.
-- 
-- This undoes the effect of @ostree_sysroot_load()@.
sysrootUnload ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Sysroot
    -> m ()
sysrootUnload :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m ()
sysrootUnload a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Sysroot -> IO ()
ostree_sysroot_unload Ptr Sysroot
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SysrootUnloadMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootUnloadMethodInfo a signature where
    overloadedMethod = sysrootUnload

instance O.OverloadedMethodInfo SysrootUnloadMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootUnload",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootUnload"
        })


#endif

-- method Sysroot::unlock
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_sysroot_unlock" ostree_sysroot_unlock :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    IO ()

-- | Clear the lock previously acquired with 'GI.OSTree.Objects.Sysroot.sysrootLock'.  It
-- is safe to call this function if the lock has not been previously
-- acquired.
sysrootUnlock ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a) =>
    a
    -- ^ /@self@/: Self
    -> m ()
sysrootUnlock :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSysroot a) =>
a -> m ()
sysrootUnlock a
self = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Sysroot -> IO ()
ostree_sysroot_unlock Ptr Sysroot
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SysrootUnlockMethodInfo
instance (signature ~ (m ()), MonadIO m, IsSysroot a) => O.OverloadedMethod SysrootUnlockMethodInfo a signature where
    overloadedMethod = sysrootUnlock

instance O.OverloadedMethodInfo SysrootUnlockMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootUnlock",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootUnlock"
        })


#endif

-- method Sysroot::write_deployments
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_deployments"
--           , argType =
--               TPtrArray
--                 (TInterface Name { namespace = "OSTree" , name = "Deployment" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "List of new deployments"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_write_deployments" ostree_sysroot_write_deployments :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr (GPtrArray (Ptr OSTree.Deployment.Deployment)) -> -- new_deployments : TPtrArray (TInterface (Name {namespace = "OSTree", name = "Deployment"}))
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Older version of 'GI.OSTree.Objects.Sysroot.sysrootWriteDeploymentsWithOptions'. This
-- version will perform post-deployment cleanup by default.
sysrootWriteDeployments ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> [OSTree.Deployment.Deployment]
    -- ^ /@newDeployments@/: List of new deployments
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootWriteDeployments :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> [Deployment] -> Maybe b -> m ()
sysrootWriteDeployments a
self [Deployment]
newDeployments Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    [Ptr Deployment]
newDeployments' <- (Deployment -> IO (Ptr Deployment))
-> [Deployment] -> IO [Ptr Deployment]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Deployment -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Deployment]
newDeployments
    Ptr (GPtrArray (Ptr Deployment))
newDeployments'' <- [Ptr Deployment] -> IO (Ptr (GPtrArray (Ptr Deployment)))
forall a. [Ptr a] -> IO (Ptr (GPtrArray (Ptr a)))
packGPtrArray [Ptr Deployment]
newDeployments'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr (GPtrArray (Ptr Deployment))
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_write_deployments Ptr Sysroot
self' Ptr (GPtrArray (Ptr Deployment))
newDeployments'' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        (Deployment -> IO ()) -> [Deployment] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deployment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Deployment]
newDeployments
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (GPtrArray (Ptr Deployment)) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray (Ptr Deployment))
newDeployments''
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr (GPtrArray (Ptr Deployment)) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray (Ptr Deployment))
newDeployments''
     )

#if defined(ENABLE_OVERLOADING)
data SysrootWriteDeploymentsMethodInfo
instance (signature ~ ([OSTree.Deployment.Deployment] -> Maybe (b) -> m ()), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootWriteDeploymentsMethodInfo a signature where
    overloadedMethod = sysrootWriteDeployments

instance O.OverloadedMethodInfo SysrootWriteDeploymentsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootWriteDeployments",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootWriteDeployments"
        })


#endif

-- method Sysroot::write_deployments_with_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Sysroot" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_deployments"
--           , argType =
--               TPtrArray
--                 (TInterface Name { namespace = "OSTree" , name = "Deployment" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "List of new deployments"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "opts"
--           , argType =
--               TInterface
--                 Name
--                   { namespace = "OSTree" , name = "SysrootWriteDeploymentsOpts" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_write_deployments_with_options" ostree_sysroot_write_deployments_with_options :: 
    Ptr Sysroot ->                          -- self : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr (GPtrArray (Ptr OSTree.Deployment.Deployment)) -> -- new_deployments : TPtrArray (TInterface (Name {namespace = "OSTree", name = "Deployment"}))
    Ptr OSTree.SysrootWriteDeploymentsOpts.SysrootWriteDeploymentsOpts -> -- opts : TInterface (Name {namespace = "OSTree", name = "SysrootWriteDeploymentsOpts"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Assuming /@newDeployments@/ have already been deployed in place on disk via
-- 'GI.OSTree.Objects.Sysroot.sysrootDeployTree', atomically update bootloader configuration. By
-- default, no post-transaction cleanup will be performed. You should invoke
-- 'GI.OSTree.Objects.Sysroot.sysrootCleanup' at some point after the transaction, or specify
-- @do_postclean@ in /@opts@/.  Skipping the post-transaction cleanup is useful
-- if for example you want to control pruning of the repository.
-- 
-- /Since: 2017.4/
sysrootWriteDeploymentsWithOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Sysroot
    -> [OSTree.Deployment.Deployment]
    -- ^ /@newDeployments@/: List of new deployments
    -> OSTree.SysrootWriteDeploymentsOpts.SysrootWriteDeploymentsOpts
    -- ^ /@opts@/: Options
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootWriteDeploymentsWithOptions :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsSysroot a, IsCancellable b) =>
a -> [Deployment] -> SysrootWriteDeploymentsOpts -> Maybe b -> m ()
sysrootWriteDeploymentsWithOptions a
self [Deployment]
newDeployments SysrootWriteDeploymentsOpts
opts Maybe b
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
self' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    [Ptr Deployment]
newDeployments' <- (Deployment -> IO (Ptr Deployment))
-> [Deployment] -> IO [Ptr Deployment]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Deployment -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [Deployment]
newDeployments
    Ptr (GPtrArray (Ptr Deployment))
newDeployments'' <- [Ptr Deployment] -> IO (Ptr (GPtrArray (Ptr Deployment)))
forall a. [Ptr a] -> IO (Ptr (GPtrArray (Ptr a)))
packGPtrArray [Ptr Deployment]
newDeployments'
    Ptr SysrootWriteDeploymentsOpts
opts' <- SysrootWriteDeploymentsOpts -> IO (Ptr SysrootWriteDeploymentsOpts)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr SysrootWriteDeploymentsOpts
opts
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Maybe b
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr (GPtrArray (Ptr Deployment))
-> Ptr SysrootWriteDeploymentsOpts
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_write_deployments_with_options Ptr Sysroot
self' Ptr (GPtrArray (Ptr Deployment))
newDeployments'' Ptr SysrootWriteDeploymentsOpts
opts' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        (Deployment -> IO ()) -> [Deployment] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Deployment -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [Deployment]
newDeployments
        SysrootWriteDeploymentsOpts -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr SysrootWriteDeploymentsOpts
opts
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (GPtrArray (Ptr Deployment)) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray (Ptr Deployment))
newDeployments''
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr (GPtrArray (Ptr Deployment)) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray (Ptr Deployment))
newDeployments''
     )

#if defined(ENABLE_OVERLOADING)
data SysrootWriteDeploymentsWithOptionsMethodInfo
instance (signature ~ ([OSTree.Deployment.Deployment] -> OSTree.SysrootWriteDeploymentsOpts.SysrootWriteDeploymentsOpts -> Maybe (b) -> m ()), MonadIO m, IsSysroot a, Gio.Cancellable.IsCancellable b) => O.OverloadedMethod SysrootWriteDeploymentsWithOptionsMethodInfo a signature where
    overloadedMethod = sysrootWriteDeploymentsWithOptions

instance O.OverloadedMethodInfo SysrootWriteDeploymentsWithOptionsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootWriteDeploymentsWithOptions",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootWriteDeploymentsWithOptions"
        })


#endif

-- method Sysroot::write_origin_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "sysroot"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Sysroot" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "System root" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "deployment"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Deployment" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Deployment" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_origin"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Origin content" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_sysroot_write_origin_file" ostree_sysroot_write_origin_file :: 
    Ptr Sysroot ->                          -- sysroot : TInterface (Name {namespace = "OSTree", name = "Sysroot"})
    Ptr OSTree.Deployment.Deployment ->     -- deployment : TInterface (Name {namespace = "OSTree", name = "Deployment"})
    Ptr GLib.KeyFile.KeyFile ->             -- new_origin : TInterface (Name {namespace = "GLib", name = "KeyFile"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Immediately replace the origin file of the referenced /@deployment@/
-- with the contents of /@newOrigin@/.  If /@newOrigin@/ is 'P.Nothing',
-- this function will write the current origin of /@deployment@/.
sysrootWriteOriginFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@sysroot@/: System root
    -> b
    -- ^ /@deployment@/: Deployment
    -> Maybe (GLib.KeyFile.KeyFile)
    -- ^ /@newOrigin@/: Origin content
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
sysrootWriteOriginFile :: forall (m :: * -> *) a b c.
(HasCallStack, MonadIO m, IsSysroot a, IsDeployment b,
 IsCancellable c) =>
a -> b -> Maybe KeyFile -> Maybe c -> m ()
sysrootWriteOriginFile a
sysroot b
deployment Maybe KeyFile
newOrigin Maybe c
cancellable = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Sysroot
sysroot' <- a -> IO (Ptr Sysroot)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
sysroot
    Ptr Deployment
deployment' <- b -> IO (Ptr Deployment)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
deployment
    Ptr KeyFile
maybeNewOrigin <- case Maybe KeyFile
newOrigin of
        Maybe KeyFile
Nothing -> Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
forall a. Ptr a
nullPtr
        Just KeyFile
jNewOrigin -> do
            Ptr KeyFile
jNewOrigin' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
jNewOrigin
            Ptr KeyFile -> IO (Ptr KeyFile)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr KeyFile
jNewOrigin'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Maybe c
Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Sysroot
-> Ptr Deployment
-> Ptr KeyFile
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_sysroot_write_origin_file Ptr Sysroot
sysroot' Ptr Deployment
deployment' Ptr KeyFile
maybeNewOrigin Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
sysroot
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
deployment
        Maybe KeyFile -> (KeyFile -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe KeyFile
newOrigin KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SysrootWriteOriginFileMethodInfo
instance (signature ~ (b -> Maybe (GLib.KeyFile.KeyFile) -> Maybe (c) -> m ()), MonadIO m, IsSysroot a, OSTree.Deployment.IsDeployment b, Gio.Cancellable.IsCancellable c) => O.OverloadedMethod SysrootWriteOriginFileMethodInfo a signature where
    overloadedMethod = sysrootWriteOriginFile

instance O.OverloadedMethodInfo SysrootWriteOriginFileMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.OSTree.Objects.Sysroot.sysrootWriteOriginFile",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ostree-1.0.15/docs/GI-OSTree-Objects-Sysroot.html#v:sysrootWriteOriginFile"
        })


#endif

-- method Sysroot::get_deployment_origin_path
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "deployment_path"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A deployment path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : False
-- Skip return : False

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

-- | /No description available in the introspection data./
sysrootGetDeploymentOriginPath ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    a
    -- ^ /@deploymentPath@/: A deployment path
    -> m Gio.File.File
    -- ^ __Returns:__ Path to deployment origin file
sysrootGetDeploymentOriginPath :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsFile a) =>
a -> m File
sysrootGetDeploymentOriginPath a
deploymentPath = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
deploymentPath' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
deploymentPath
    Ptr File
result <- Ptr File -> IO (Ptr File)
ostree_sysroot_get_deployment_origin_path Ptr File
deploymentPath'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"sysrootGetDeploymentOriginPath" Ptr File
result
    File
result' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
deploymentPath
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif