{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- 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.BootconfigParser
    ( 

-- * Exported types
    BootconfigParser(..)                    ,
    IsBootconfigParser                      ,
    toBootconfigParser                      ,
    noBootconfigParser                      ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveBootconfigParserMethod           ,
#endif


-- ** clone #method:clone#

#if defined(ENABLE_OVERLOADING)
    BootconfigParserCloneMethodInfo         ,
#endif
    bootconfigParserClone                   ,


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    BootconfigParserGetMethodInfo           ,
#endif
    bootconfigParserGet                     ,


-- ** new #method:new#

    bootconfigParserNew                     ,


-- ** parse #method:parse#

#if defined(ENABLE_OVERLOADING)
    BootconfigParserParseMethodInfo         ,
#endif
    bootconfigParserParse                   ,


-- ** parseAt #method:parseAt#

#if defined(ENABLE_OVERLOADING)
    BootconfigParserParseAtMethodInfo       ,
#endif
    bootconfigParserParseAt                 ,


-- ** set #method:set#

#if defined(ENABLE_OVERLOADING)
    BootconfigParserSetMethodInfo           ,
#endif
    bootconfigParserSet                     ,


-- ** write #method:write#

#if defined(ENABLE_OVERLOADING)
    BootconfigParserWriteMethodInfo         ,
#endif
    bootconfigParserWrite                   ,


-- ** writeAt #method:writeAt#

#if defined(ENABLE_OVERLOADING)
    BootconfigParserWriteAtMethodInfo       ,
#endif
    bootconfigParserWriteAt                 ,




    ) 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.ManagedPtr as B.ManagedPtr
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 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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable

-- | Memory-managed wrapper type.
newtype BootconfigParser = BootconfigParser (ManagedPtr BootconfigParser)
    deriving (BootconfigParser -> BootconfigParser -> Bool
(BootconfigParser -> BootconfigParser -> Bool)
-> (BootconfigParser -> BootconfigParser -> Bool)
-> Eq BootconfigParser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BootconfigParser -> BootconfigParser -> Bool
$c/= :: BootconfigParser -> BootconfigParser -> Bool
== :: BootconfigParser -> BootconfigParser -> Bool
$c== :: BootconfigParser -> BootconfigParser -> Bool
Eq)
foreign import ccall "ostree_bootconfig_parser_get_type"
    c_ostree_bootconfig_parser_get_type :: IO GType

instance GObject BootconfigParser where
    gobjectType :: IO GType
gobjectType = IO GType
c_ostree_bootconfig_parser_get_type
    

-- | Convert 'BootconfigParser' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue BootconfigParser where
    toGValue :: BootconfigParser -> IO GValue
toGValue o :: BootconfigParser
o = do
        GType
gtype <- IO GType
c_ostree_bootconfig_parser_get_type
        BootconfigParser
-> (Ptr BootconfigParser -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr BootconfigParser
o (GType
-> (GValue -> Ptr BootconfigParser -> IO ())
-> Ptr BootconfigParser
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr BootconfigParser -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO BootconfigParser
fromGValue gv :: GValue
gv = do
        Ptr BootconfigParser
ptr <- GValue -> IO (Ptr BootconfigParser)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr BootconfigParser)
        (ManagedPtr BootconfigParser -> BootconfigParser)
-> Ptr BootconfigParser -> IO BootconfigParser
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr BootconfigParser -> BootconfigParser
BootconfigParser Ptr BootconfigParser
ptr
        
    

-- | Type class for types which can be safely cast to `BootconfigParser`, for instance with `toBootconfigParser`.
class (GObject o, O.IsDescendantOf BootconfigParser o) => IsBootconfigParser o
instance (GObject o, O.IsDescendantOf BootconfigParser o) => IsBootconfigParser o

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

-- | Cast to `BootconfigParser`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toBootconfigParser :: (MonadIO m, IsBootconfigParser o) => o -> m BootconfigParser
toBootconfigParser :: o -> m BootconfigParser
toBootconfigParser = IO BootconfigParser -> m BootconfigParser
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BootconfigParser -> m BootconfigParser)
-> (o -> IO BootconfigParser) -> o -> m BootconfigParser
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr BootconfigParser -> BootconfigParser)
-> o -> IO BootconfigParser
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr BootconfigParser -> BootconfigParser
BootconfigParser

-- | A convenience alias for `Nothing` :: `Maybe` `BootconfigParser`.
noBootconfigParser :: Maybe BootconfigParser
noBootconfigParser :: Maybe BootconfigParser
noBootconfigParser = Maybe BootconfigParser
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveBootconfigParserMethod (t :: Symbol) (o :: *) :: * where
    ResolveBootconfigParserMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveBootconfigParserMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveBootconfigParserMethod "clone" o = BootconfigParserCloneMethodInfo
    ResolveBootconfigParserMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveBootconfigParserMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveBootconfigParserMethod "get" o = BootconfigParserGetMethodInfo
    ResolveBootconfigParserMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveBootconfigParserMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveBootconfigParserMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveBootconfigParserMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveBootconfigParserMethod "parse" o = BootconfigParserParseMethodInfo
    ResolveBootconfigParserMethod "parseAt" o = BootconfigParserParseAtMethodInfo
    ResolveBootconfigParserMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveBootconfigParserMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveBootconfigParserMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveBootconfigParserMethod "set" o = BootconfigParserSetMethodInfo
    ResolveBootconfigParserMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveBootconfigParserMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveBootconfigParserMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveBootconfigParserMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveBootconfigParserMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveBootconfigParserMethod "write" o = BootconfigParserWriteMethodInfo
    ResolveBootconfigParserMethod "writeAt" o = BootconfigParserWriteAtMethodInfo
    ResolveBootconfigParserMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveBootconfigParserMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveBootconfigParserMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveBootconfigParserMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveBootconfigParserMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveBootconfigParserMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveBootconfigParserMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveBootconfigParserMethod t BootconfigParser, O.MethodInfo info BootconfigParser p) => OL.IsLabel t (BootconfigParser -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "ostree_bootconfig_parser_new" ostree_bootconfig_parser_new :: 
    IO (Ptr BootconfigParser)

-- | /No description available in the introspection data./
bootconfigParserNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m BootconfigParser
bootconfigParserNew :: m BootconfigParser
bootconfigParserNew  = IO BootconfigParser -> m BootconfigParser
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BootconfigParser -> m BootconfigParser)
-> IO BootconfigParser -> m BootconfigParser
forall a b. (a -> b) -> a -> b
$ do
    Ptr BootconfigParser
result <- IO (Ptr BootconfigParser)
ostree_bootconfig_parser_new
    Text -> Ptr BootconfigParser -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "bootconfigParserNew" Ptr BootconfigParser
result
    BootconfigParser
result' <- ((ManagedPtr BootconfigParser -> BootconfigParser)
-> Ptr BootconfigParser -> IO BootconfigParser
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BootconfigParser -> BootconfigParser
BootconfigParser) Ptr BootconfigParser
result
    BootconfigParser -> IO BootconfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return BootconfigParser
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

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

-- | /No description available in the introspection data./
bootconfigParserClone ::
    (B.CallStack.HasCallStack, MonadIO m, IsBootconfigParser a) =>
    a
    -- ^ /@self@/: Bootconfig to clone
    -> m BootconfigParser
    -- ^ __Returns:__ Copy of /@self@/
bootconfigParserClone :: a -> m BootconfigParser
bootconfigParserClone self :: a
self = IO BootconfigParser -> m BootconfigParser
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO BootconfigParser -> m BootconfigParser)
-> IO BootconfigParser -> m BootconfigParser
forall a b. (a -> b) -> a -> b
$ do
    Ptr BootconfigParser
self' <- a -> IO (Ptr BootconfigParser)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr BootconfigParser
result <- Ptr BootconfigParser -> IO (Ptr BootconfigParser)
ostree_bootconfig_parser_clone Ptr BootconfigParser
self'
    Text -> Ptr BootconfigParser -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "bootconfigParserClone" Ptr BootconfigParser
result
    BootconfigParser
result' <- ((ManagedPtr BootconfigParser -> BootconfigParser)
-> Ptr BootconfigParser -> IO BootconfigParser
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr BootconfigParser -> BootconfigParser
BootconfigParser) Ptr BootconfigParser
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    BootconfigParser -> IO BootconfigParser
forall (m :: * -> *) a. Monad m => a -> m a
return BootconfigParser
result'

#if defined(ENABLE_OVERLOADING)
data BootconfigParserCloneMethodInfo
instance (signature ~ (m BootconfigParser), MonadIO m, IsBootconfigParser a) => O.MethodInfo BootconfigParserCloneMethodInfo a signature where
    overloadedMethod = bootconfigParserClone

#endif

-- method BootconfigParser::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "BootconfigParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_bootconfig_parser_get" ostree_bootconfig_parser_get :: 
    Ptr BootconfigParser ->                 -- self : TInterface (Name {namespace = "OSTree", name = "BootconfigParser"})
    CString ->                              -- key : TBasicType TUTF8
    IO CString

-- | /No description available in the introspection data./
bootconfigParserGet ::
    (B.CallStack.HasCallStack, MonadIO m, IsBootconfigParser a) =>
    a
    -> T.Text
    -> m T.Text
bootconfigParserGet :: a -> Text -> m Text
bootconfigParserGet self :: a
self key :: Text
key = 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 BootconfigParser
self' <- a -> IO (Ptr BootconfigParser)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
result <- Ptr BootconfigParser -> CString -> IO CString
ostree_bootconfig_parser_get Ptr BootconfigParser
self' CString
key'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "bootconfigParserGet" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data BootconfigParserGetMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsBootconfigParser a) => O.MethodInfo BootconfigParserGetMethodInfo a signature where
    overloadedMethod = bootconfigParserGet

#endif

-- method BootconfigParser::parse
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "BootconfigParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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_bootconfig_parser_parse" ostree_bootconfig_parser_parse :: 
    Ptr BootconfigParser ->                 -- self : TInterface (Name {namespace = "OSTree", name = "BootconfigParser"})
    Ptr Gio.File.File ->                    -- path : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
bootconfigParserParse ::
    (B.CallStack.HasCallStack, MonadIO m, IsBootconfigParser a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -> b
    -> Maybe (c)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
bootconfigParserParse :: a -> b -> Maybe c -> m ()
bootconfigParserParse self :: a
self path :: b
path cancellable :: 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 BootconfigParser
self' <- a -> IO (Ptr BootconfigParser)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
path' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
path
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 BootconfigParser
-> Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_bootconfig_parser_parse Ptr BootconfigParser
self' Ptr File
path' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
path
        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 BootconfigParserParseMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsBootconfigParser a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.MethodInfo BootconfigParserParseMethodInfo a signature where
    overloadedMethod = bootconfigParserParse

#endif

-- method BootconfigParser::parse_at
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "BootconfigParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Parser" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dfd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Directory fd" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "File path" , 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_bootconfig_parser_parse_at" ostree_bootconfig_parser_parse_at :: 
    Ptr BootconfigParser ->                 -- self : TInterface (Name {namespace = "OSTree", name = "BootconfigParser"})
    Int32 ->                                -- dfd : TBasicType TInt
    CString ->                              -- path : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Initialize a bootconfig from the given file.
bootconfigParserParseAt ::
    (B.CallStack.HasCallStack, MonadIO m, IsBootconfigParser a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Parser
    -> Int32
    -- ^ /@dfd@/: Directory fd
    -> T.Text
    -- ^ /@path@/: File path
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
bootconfigParserParseAt :: a -> Int32 -> Text -> Maybe b -> m ()
bootconfigParserParseAt self :: a
self dfd :: Int32
dfd path :: Text
path cancellable :: 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 BootconfigParser
self' <- a -> IO (Ptr BootconfigParser)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 BootconfigParser
-> Int32
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_bootconfig_parser_parse_at Ptr BootconfigParser
self' Int32
dfd CString
path' 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
path'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
data BootconfigParserParseAtMethodInfo
instance (signature ~ (Int32 -> T.Text -> Maybe (b) -> m ()), MonadIO m, IsBootconfigParser a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BootconfigParserParseAtMethodInfo a signature where
    overloadedMethod = bootconfigParserParseAt

#endif

-- method BootconfigParser::set
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "BootconfigParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TUTF8
--           , 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_bootconfig_parser_set" ostree_bootconfig_parser_set :: 
    Ptr BootconfigParser ->                 -- self : TInterface (Name {namespace = "OSTree", name = "BootconfigParser"})
    CString ->                              -- key : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
bootconfigParserSet ::
    (B.CallStack.HasCallStack, MonadIO m, IsBootconfigParser a) =>
    a
    -> T.Text
    -> T.Text
    -> m ()
bootconfigParserSet :: a -> Text -> Text -> m ()
bootconfigParserSet self :: a
self key :: Text
key value :: Text
value = 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 BootconfigParser
self' <- a -> IO (Ptr BootconfigParser)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
key' <- Text -> IO CString
textToCString Text
key
    CString
value' <- Text -> IO CString
textToCString Text
value
    Ptr BootconfigParser -> CString -> CString -> IO ()
ostree_bootconfig_parser_set Ptr BootconfigParser
self' CString
key' CString
value'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
key'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BootconfigParserSetMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsBootconfigParser a) => O.MethodInfo BootconfigParserSetMethodInfo a signature where
    overloadedMethod = bootconfigParserSet

#endif

-- method BootconfigParser::write
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "BootconfigParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "output"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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_bootconfig_parser_write" ostree_bootconfig_parser_write :: 
    Ptr BootconfigParser ->                 -- self : TInterface (Name {namespace = "OSTree", name = "BootconfigParser"})
    Ptr Gio.File.File ->                    -- output : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
bootconfigParserWrite ::
    (B.CallStack.HasCallStack, MonadIO m, IsBootconfigParser a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -> b
    -> Maybe (c)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
bootconfigParserWrite :: a -> b -> Maybe c -> m ()
bootconfigParserWrite self :: a
self output :: b
output cancellable :: 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 BootconfigParser
self' <- a -> IO (Ptr BootconfigParser)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
output' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
output
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 BootconfigParser
-> Ptr File -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_bootconfig_parser_write Ptr BootconfigParser
self' Ptr File
output' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
output
        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 BootconfigParserWriteMethodInfo
instance (signature ~ (b -> Maybe (c) -> m ()), MonadIO m, IsBootconfigParser a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.MethodInfo BootconfigParserWriteMethodInfo a signature where
    overloadedMethod = bootconfigParserWrite

#endif

-- method BootconfigParser::write_at
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "BootconfigParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dfd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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_bootconfig_parser_write_at" ostree_bootconfig_parser_write_at :: 
    Ptr BootconfigParser ->                 -- self : TInterface (Name {namespace = "OSTree", name = "BootconfigParser"})
    Int32 ->                                -- dfd : TBasicType TInt
    CString ->                              -- path : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
bootconfigParserWriteAt ::
    (B.CallStack.HasCallStack, MonadIO m, IsBootconfigParser a, Gio.Cancellable.IsCancellable b) =>
    a
    -> Int32
    -> T.Text
    -> Maybe (b)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
bootconfigParserWriteAt :: a -> Int32 -> Text -> Maybe b -> m ()
bootconfigParserWriteAt self :: a
self dfd :: Int32
dfd path :: Text
path cancellable :: 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 BootconfigParser
self' <- a -> IO (Ptr BootconfigParser)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: 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 BootconfigParser
-> Int32
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_bootconfig_parser_write_at Ptr BootconfigParser
self' Int32
dfd CString
path' 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
path'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
data BootconfigParserWriteAtMethodInfo
instance (signature ~ (Int32 -> T.Text -> Maybe (b) -> m ()), MonadIO m, IsBootconfigParser a, Gio.Cancellable.IsCancellable b) => O.MethodInfo BootconfigParserWriteAtMethodInfo a signature where
    overloadedMethod = bootconfigParserWriteAt

#endif