{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a git configuration.

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

module GI.Ggit.Objects.Config
    ( 

-- * Exported types
    Config(..)                              ,
    IsConfig                                ,
    toConfig                                ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveConfigMethod                     ,
#endif


-- ** addFile #method:addFile#

#if defined(ENABLE_OVERLOADING)
    ConfigAddFileMethodInfo                 ,
#endif
    configAddFile                           ,


-- ** deleteEntry #method:deleteEntry#

#if defined(ENABLE_OVERLOADING)
    ConfigDeleteEntryMethodInfo             ,
#endif
    configDeleteEntry                       ,


-- ** findGlobal #method:findGlobal#

    configFindGlobal                        ,


-- ** findSystem #method:findSystem#

    configFindSystem                        ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    ConfigForeachMethodInfo                 ,
#endif
    configForeach                           ,


-- ** getBool #method:getBool#

#if defined(ENABLE_OVERLOADING)
    ConfigGetBoolMethodInfo                 ,
#endif
    configGetBool                           ,


-- ** getEntry #method:getEntry#

#if defined(ENABLE_OVERLOADING)
    ConfigGetEntryMethodInfo                ,
#endif
    configGetEntry                          ,


-- ** getInt32 #method:getInt32#

#if defined(ENABLE_OVERLOADING)
    ConfigGetInt32MethodInfo                ,
#endif
    configGetInt32                          ,


-- ** getInt64 #method:getInt64#

#if defined(ENABLE_OVERLOADING)
    ConfigGetInt64MethodInfo                ,
#endif
    configGetInt64                          ,


-- ** getString #method:getString#

#if defined(ENABLE_OVERLOADING)
    ConfigGetStringMethodInfo               ,
#endif
    configGetString                         ,


-- ** match #method:match#

#if defined(ENABLE_OVERLOADING)
    ConfigMatchMethodInfo                   ,
#endif
    configMatch                             ,


-- ** matchForeach #method:matchForeach#

#if defined(ENABLE_OVERLOADING)
    ConfigMatchForeachMethodInfo            ,
#endif
    configMatchForeach                      ,


-- ** new #method:new#

    configNew                               ,


-- ** newDefault #method:newDefault#

    configNewDefault                        ,


-- ** newFromFile #method:newFromFile#

    configNewFromFile                       ,


-- ** openLevel #method:openLevel#

#if defined(ENABLE_OVERLOADING)
    ConfigOpenLevelMethodInfo               ,
#endif
    configOpenLevel                         ,


-- ** setBool #method:setBool#

#if defined(ENABLE_OVERLOADING)
    ConfigSetBoolMethodInfo                 ,
#endif
    configSetBool                           ,


-- ** setInt32 #method:setInt32#

#if defined(ENABLE_OVERLOADING)
    ConfigSetInt32MethodInfo                ,
#endif
    configSetInt32                          ,


-- ** setInt64 #method:setInt64#

#if defined(ENABLE_OVERLOADING)
    ConfigSetInt64MethodInfo                ,
#endif
    configSetInt64                          ,


-- ** setString #method:setString#

#if defined(ENABLE_OVERLOADING)
    ConfigSetStringMethodInfo               ,
#endif
    configSetString                         ,


-- ** snapshot #method:snapshot#

#if defined(ENABLE_OVERLOADING)
    ConfigSnapshotMethodInfo                ,
#endif
    configSnapshot                          ,




    ) 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.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.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.GLib.Structs.MatchInfo as GLib.MatchInfo
import qualified GI.GLib.Structs.Regex as GLib.Regex
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Ggit.Callbacks as Ggit.Callbacks
import {-# SOURCE #-} qualified GI.Ggit.Enums as Ggit.Enums
import {-# SOURCE #-} qualified GI.Ggit.Objects.Native as Ggit.Native
import {-# SOURCE #-} qualified GI.Ggit.Objects.ObjectFactoryBase as Ggit.ObjectFactoryBase
import {-# SOURCE #-} qualified GI.Ggit.Structs.ConfigEntry as Ggit.ConfigEntry
import qualified GI.Gio.Interfaces.File as Gio.File

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

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

foreign import ccall "ggit_config_get_type"
    c_ggit_config_get_type :: IO B.Types.GType

instance B.Types.TypedObject Config where
    glibType :: IO GType
glibType = IO GType
c_ggit_config_get_type

instance B.Types.GObject Config

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

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

instance O.HasParentTypes Config
type instance O.ParentTypes Config = '[Ggit.Native.Native, Ggit.ObjectFactoryBase.ObjectFactoryBase, GObject.Object.Object]

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

#if defined(ENABLE_OVERLOADING)
type family ResolveConfigMethod (t :: Symbol) (o :: *) :: * where
    ResolveConfigMethod "addFile" o = ConfigAddFileMethodInfo
    ResolveConfigMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveConfigMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveConfigMethod "deleteEntry" o = ConfigDeleteEntryMethodInfo
    ResolveConfigMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveConfigMethod "foreach" o = ConfigForeachMethodInfo
    ResolveConfigMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveConfigMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveConfigMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveConfigMethod "match" o = ConfigMatchMethodInfo
    ResolveConfigMethod "matchForeach" o = ConfigMatchForeachMethodInfo
    ResolveConfigMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveConfigMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveConfigMethod "openLevel" o = ConfigOpenLevelMethodInfo
    ResolveConfigMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveConfigMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveConfigMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveConfigMethod "snapshot" o = ConfigSnapshotMethodInfo
    ResolveConfigMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveConfigMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveConfigMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveConfigMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveConfigMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveConfigMethod "getBool" o = ConfigGetBoolMethodInfo
    ResolveConfigMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveConfigMethod "getEntry" o = ConfigGetEntryMethodInfo
    ResolveConfigMethod "getInt32" o = ConfigGetInt32MethodInfo
    ResolveConfigMethod "getInt64" o = ConfigGetInt64MethodInfo
    ResolveConfigMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveConfigMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveConfigMethod "getString" o = ConfigGetStringMethodInfo
    ResolveConfigMethod "setBool" o = ConfigSetBoolMethodInfo
    ResolveConfigMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveConfigMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveConfigMethod "setInt32" o = ConfigSetInt32MethodInfo
    ResolveConfigMethod "setInt64" o = ConfigSetInt64MethodInfo
    ResolveConfigMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveConfigMethod "setString" o = ConfigSetStringMethodInfo
    ResolveConfigMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveConfigMethod t Config, O.MethodInfo info Config p) => OL.IsLabel t (Config -> 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 Config
type instance O.AttributeList Config = ConfigAttributeList
type ConfigAttributeList = ('[ '("native", Ggit.Native.NativeNativePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "ggit_config_new" ggit_config_new :: 
    IO (Ptr Config)

-- | Create a new config. See also @/ggit_config_get_default()/@ to get
-- a t'GI.Ggit.Objects.Config.Config' representing the global, XDG and system configuration files.
-- To get a t'GI.Ggit.Objects.Config.Config' for a repository use @/ggit_repository_get_config/@
-- instead.
configNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Config
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Config.Config'.
configNew :: m Config
configNew  = IO Config -> m Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> m Config) -> IO Config -> m Config
forall a b. (a -> b) -> a -> b
$ do
    Ptr Config
result <- IO (Ptr Config)
ggit_config_new
    Text -> Ptr Config -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configNew" Ptr Config
result
    Config
result' <- ((ManagedPtr Config -> Config) -> Ptr Config -> IO Config
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Config -> Config
Config) Ptr Config
result
    Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ggit_config_new_default" ggit_config_new_default :: 
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Config)

-- | Get the global, XDG and system configuration files merged into one
-- t'GI.Ggit.Objects.Config.Config' with their appropriate priority levels. If an error occured
-- trying to load the various configuration files, this function will return
-- 'P.Nothing' and /@error@/ will be set accordingly.
configNewDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Config
    -- ^ __Returns:__ A t'GI.Ggit.Objects.Config.Config' /(Can throw 'Data.GI.Base.GError.GError')/
configNewDefault :: m Config
configNewDefault  = IO Config -> m Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> m Config) -> IO Config -> m Config
forall a b. (a -> b) -> a -> b
$ do
    IO Config -> IO () -> IO Config
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Config
result <- (Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config))
-> (Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config)
forall a b. (a -> b) -> a -> b
$ Ptr (Ptr GError) -> IO (Ptr Config)
ggit_config_new_default
        Text -> Ptr Config -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configNewDefault" Ptr Config
result
        Config
result' <- ((ManagedPtr Config -> Config) -> Ptr Config -> IO Config
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Config -> Config
Config) Ptr Config
result
        Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Config::new_from_file
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the file to load." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Config" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_config_new_from_file" ggit_config_new_from_file :: 
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Config)

-- | Create a new config from a single on disk file. This is a convenience
-- API and is exactly the same as creating an empty t'GI.Ggit.Objects.Config.Config' using
-- @/ggit_config_new/@ and adding the file with @/ggit_config_add_file/@. The
-- level will be set to @/GGIT_CONFIG_LEVEL_LOCAL/@. If the config could not be
-- loaded this function returns 'P.Nothing' and /@error@/ will be set accordingly.
configNewFromFile ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    a
    -- ^ /@file@/: the file to load.
    -> m Config
    -- ^ __Returns:__ a t'GI.Ggit.Objects.Config.Config'. /(Can throw 'Data.GI.Base.GError.GError')/
configNewFromFile :: a -> m Config
configNewFromFile a
file = IO Config -> m Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> m Config) -> IO Config -> m Config
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
file' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
file
    IO Config -> IO () -> IO Config
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Config
result <- (Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config))
-> (Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config)
forall a b. (a -> b) -> a -> b
$ Ptr File -> Ptr (Ptr GError) -> IO (Ptr Config)
ggit_config_new_from_file Ptr File
file'
        Text -> Ptr Config -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configNewFromFile" Ptr Config
result
        Config
result' <- ((ManagedPtr Config -> Config) -> Ptr Config -> IO Config
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Config -> Config
Config) Ptr Config
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
file
        Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Config::add_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GFile." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "level"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "ConfigLevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfigLevel."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "force"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "if a config file already exists for the given priority level, replace it."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_config_add_file" ggit_config_add_file :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    Ptr Gio.File.File ->                    -- file : TInterface (Name {namespace = "Gio", name = "File"})
    CInt ->                                 -- level : TInterface (Name {namespace = "Ggit", name = "ConfigLevel"})
    CInt ->                                 -- force : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Add an on-disk config file instance to an existing config
-- 
-- The on-disk file pointed at by /@file@/ will be opened and
-- parsed; it\'s expected to be a native Git config file following
-- the default Git config syntax (see man git-config).
-- 
-- Further queries on this config object will access each
-- of the config file instances in order (instances with
-- a higher priority level will be accessed first).
configAddFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a, Gio.File.IsFile b) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> b
    -- ^ /@file@/: a t'GI.Gio.Interfaces.File.File'.
    -> Ggit.Enums.ConfigLevel
    -- ^ /@level@/: a t'GI.Ggit.Enums.ConfigLevel'.
    -> Bool
    -- ^ /@force@/: if a config file already exists for the given priority level, replace it.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configAddFile :: a -> b -> ConfigLevel -> Bool -> m ()
configAddFile a
config b
file ConfigLevel
level Bool
force = 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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    Ptr File
file' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
file
    let level' :: CInt
level' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ConfigLevel -> Int) -> ConfigLevel -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigLevel -> Int
forall a. Enum a => a -> Int
fromEnum) ConfigLevel
level
    let force' :: CInt
force' = (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
force
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO ()) -> IO ())
-> (Ptr (Ptr GError) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Config -> Ptr File -> CInt -> CInt -> Ptr (Ptr GError) -> IO ()
ggit_config_add_file Ptr Config
config' Ptr File
file' CInt
level' CInt
force'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
file
        () -> 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 ConfigAddFileMethodInfo
instance (signature ~ (b -> Ggit.Enums.ConfigLevel -> Bool -> m ()), MonadIO m, IsConfig a, Gio.File.IsFile b) => O.MethodInfo ConfigAddFileMethodInfo a signature where
    overloadedMethod = configAddFile

#endif

-- method Config::delete_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the configuration value."
--                 , 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 "ggit_config_delete_entry" ggit_config_delete_entry :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Delete a config variable from the config file.
configDeleteEntry ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the configuration value.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configDeleteEntry :: a -> Text -> m ()
configDeleteEntry a
config Text
name = 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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    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 Config -> CString -> Ptr (Ptr GError) -> IO CInt
ggit_config_delete_entry Ptr Config
config' CString
name'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

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

#endif

-- method Config::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "ConfigCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfigCallback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the user data for @callback."
--                 , 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 "ggit_config_foreach" ggit_config_foreach :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    FunPtr Ggit.Callbacks.C_ConfigCallback -> -- callback : TInterface (Name {namespace = "Ggit", name = "ConfigCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Call /@callback@/ for each configuration value.
configForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> Ggit.Callbacks.ConfigCallback
    -- ^ /@callback@/: a t'GI.Ggit.Callbacks.ConfigCallback'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configForeach :: a -> ConfigCallback -> m ()
configForeach a
config ConfigCallback
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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    FunPtr C_ConfigCallback
callback' <- C_ConfigCallback -> IO (FunPtr C_ConfigCallback)
Ggit.Callbacks.mk_ConfigCallback (Maybe (Ptr (FunPtr C_ConfigCallback))
-> ConfigCallback_WithClosures -> C_ConfigCallback
Ggit.Callbacks.wrap_ConfigCallback Maybe (Ptr (FunPtr C_ConfigCallback))
forall a. Maybe a
Nothing (ConfigCallback -> ConfigCallback_WithClosures
Ggit.Callbacks.drop_closures_ConfigCallback ConfigCallback
callback))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    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 Config
-> FunPtr C_ConfigCallback -> Ptr () -> Ptr (Ptr GError) -> IO CInt
ggit_config_foreach Ptr Config
config' FunPtr C_ConfigCallback
callback' Ptr ()
forall a. Ptr a
userData
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ConfigCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ConfigCallback
callback'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ConfigCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ConfigCallback
callback'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ConfigForeachMethodInfo
instance (signature ~ (Ggit.Callbacks.ConfigCallback -> m ()), MonadIO m, IsConfig a) => O.MethodInfo ConfigForeachMethodInfo a signature where
    overloadedMethod = configForeach

#endif

-- method Config::get_bool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the configuration value."
--                 , 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 "ggit_config_get_bool" ggit_config_get_bool :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Get a boolean configuration value.
configGetBool ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the name of the configuration value.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configGetBool :: a -> Text -> m ()
configGetBool a
config Text
name = 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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    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 Config -> CString -> Ptr (Ptr GError) -> IO CInt
ggit_config_get_bool Ptr Config
config' CString
name'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

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

#endif

-- method Config::get_entry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the configuration name."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Ggit" , name = "ConfigEntry" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_config_get_entry" ggit_config_get_entry :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Ggit.ConfigEntry.ConfigEntry)

-- | Get t'GI.Ggit.Structs.ConfigEntry.ConfigEntry' of a config variable.
configGetEntry ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the configuration name.
    -> m Ggit.ConfigEntry.ConfigEntry
    -- ^ __Returns:__ the entry of /@name@/, or 'P.Nothing' if such a value
    --                           does not exist. /(Can throw 'Data.GI.Base.GError.GError')/
configGetEntry :: a -> Text -> m ConfigEntry
configGetEntry a
config Text
name = IO ConfigEntry -> m ConfigEntry
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConfigEntry -> m ConfigEntry)
-> IO ConfigEntry -> m ConfigEntry
forall a b. (a -> b) -> a -> b
$ do
    Ptr Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    IO ConfigEntry -> IO () -> IO ConfigEntry
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr ConfigEntry
result <- (Ptr (Ptr GError) -> IO (Ptr ConfigEntry)) -> IO (Ptr ConfigEntry)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr ConfigEntry))
 -> IO (Ptr ConfigEntry))
-> (Ptr (Ptr GError) -> IO (Ptr ConfigEntry))
-> IO (Ptr ConfigEntry)
forall a b. (a -> b) -> a -> b
$ Ptr Config -> CString -> Ptr (Ptr GError) -> IO (Ptr ConfigEntry)
ggit_config_get_entry Ptr Config
config' CString
name'
        Text -> Ptr ConfigEntry -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configGetEntry" Ptr ConfigEntry
result
        ConfigEntry
result' <- ((ManagedPtr ConfigEntry -> ConfigEntry)
-> Ptr ConfigEntry -> IO ConfigEntry
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr ConfigEntry -> ConfigEntry
Ggit.ConfigEntry.ConfigEntry) Ptr ConfigEntry
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        ConfigEntry -> IO ConfigEntry
forall (m :: * -> *) a. Monad m => a -> m a
return ConfigEntry
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

#if defined(ENABLE_OVERLOADING)
data ConfigGetEntryMethodInfo
instance (signature ~ (T.Text -> m Ggit.ConfigEntry.ConfigEntry), MonadIO m, IsConfig a) => O.MethodInfo ConfigGetEntryMethodInfo a signature where
    overloadedMethod = configGetEntry

#endif

-- method Config::get_int32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the configuration value."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt32)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_config_get_int32" ggit_config_get_int32 :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Get a int32 configuration value.
configGetInt32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the name of the configuration value.
    -> m Int32
    -- ^ __Returns:__ the value. /(Can throw 'Data.GI.Base.GError.GError')/
configGetInt32 :: a -> Text -> m Int32
configGetInt32 a
config Text
name = 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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    IO Int32 -> IO () -> IO Int32
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Config -> CString -> Ptr (Ptr GError) -> IO Int32
ggit_config_get_int32 Ptr Config
config' CString
name'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

#if defined(ENABLE_OVERLOADING)
data ConfigGetInt32MethodInfo
instance (signature ~ (T.Text -> m Int32), MonadIO m, IsConfig a) => O.MethodInfo ConfigGetInt32MethodInfo a signature where
    overloadedMethod = configGetInt32

#endif

-- method Config::get_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the configuration value."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt64)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_config_get_int64" ggit_config_get_int64 :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO Int64

-- | Get a int64 configuration value.
configGetInt64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the name of the configuration value.
    -> m Int64
    -- ^ __Returns:__ the value. /(Can throw 'Data.GI.Base.GError.GError')/
configGetInt64 :: a -> Text -> m Int64
configGetInt64 a
config Text
name = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    IO Int64 -> IO () -> IO Int64
forall a b. IO a -> IO b -> IO a
onException (do
        Int64
result <- (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int64) -> IO Int64)
-> (Ptr (Ptr GError) -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ Ptr Config -> CString -> Ptr (Ptr GError) -> IO Int64
ggit_config_get_int64 Ptr Config
config' CString
name'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

#if defined(ENABLE_OVERLOADING)
data ConfigGetInt64MethodInfo
instance (signature ~ (T.Text -> m Int64), MonadIO m, IsConfig a) => O.MethodInfo ConfigGetInt64MethodInfo a signature where
    overloadedMethod = configGetInt64

#endif

-- method Config::get_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the configuration value."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_config_get_string" ggit_config_get_string :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Get the configuration value of /@name@/ as string.
configGetString ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the name of the configuration value.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the string value of /@name@/, or 'P.Nothing' if such a value
    --                        does not exist /(Can throw 'Data.GI.Base.GError.GError')/
configGetString :: a -> Text -> m (Maybe Text)
configGetString a
config Text
name = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    IO (Maybe Text) -> IO () -> IO (Maybe Text)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr Config -> CString -> Ptr (Ptr GError) -> IO CString
ggit_config_get_string Ptr Config
config' CString
name'
        Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
            Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
            Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

#if defined(ENABLE_OVERLOADING)
data ConfigGetStringMethodInfo
instance (signature ~ (T.Text -> m (Maybe T.Text)), MonadIO m, IsConfig a) => O.MethodInfo ConfigGetStringMethodInfo a signature where
    overloadedMethod = configGetString

#endif

-- method Config::match
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "regex"
--           , argType = TInterface Name { namespace = "GLib" , name = "Regex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRegex." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "match_info"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "MatchInfo" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GMatchInfo." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : True
-- Skip return : False

foreign import ccall "ggit_config_match" ggit_config_match :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    Ptr GLib.Regex.Regex ->                 -- regex : TInterface (Name {namespace = "GLib", name = "Regex"})
    Ptr (Ptr GLib.MatchInfo.MatchInfo) ->   -- match_info : TInterface (Name {namespace = "GLib", name = "MatchInfo"})
    Ptr (Ptr GError) ->                     -- error
    IO CString

-- | Matches a configuration against a regular expression. /@matchInfo@/ will
-- contain the match information if the return value is not 'P.Nothing', otherwise
-- /@error@/ will be set.
configMatch ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> GLib.Regex.Regex
    -- ^ /@regex@/: a t'GI.GLib.Structs.Regex.Regex'.
    -> m ((Maybe T.Text, GLib.MatchInfo.MatchInfo))
    -- ^ __Returns:__ the value of that matched configuration /(Can throw 'Data.GI.Base.GError.GError')/
configMatch :: a -> Regex -> m (Maybe Text, MatchInfo)
configMatch a
config Regex
regex = IO (Maybe Text, MatchInfo) -> m (Maybe Text, MatchInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, MatchInfo) -> m (Maybe Text, MatchInfo))
-> IO (Maybe Text, MatchInfo) -> m (Maybe Text, MatchInfo)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    Ptr Regex
regex' <- Regex -> IO (Ptr Regex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Regex
regex
    Ptr (Ptr MatchInfo)
matchInfo <- IO (Ptr (Ptr MatchInfo))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr GLib.MatchInfo.MatchInfo))
    IO (Maybe Text, MatchInfo) -> IO () -> IO (Maybe Text, MatchInfo)
forall a b. IO a -> IO b -> IO a
onException (do
        CString
result <- (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CString) -> IO CString)
-> (Ptr (Ptr GError) -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ Ptr Config
-> Ptr Regex
-> Ptr (Ptr MatchInfo)
-> Ptr (Ptr GError)
-> IO CString
ggit_config_match Ptr Config
config' Ptr Regex
regex' Ptr (Ptr MatchInfo)
matchInfo
        Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
result' -> do
            Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
            CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result'
            Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
        Ptr MatchInfo
matchInfo' <- Ptr (Ptr MatchInfo) -> IO (Ptr MatchInfo)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr MatchInfo)
matchInfo
        MatchInfo
matchInfo'' <- ((ManagedPtr MatchInfo -> MatchInfo)
-> Ptr MatchInfo -> IO MatchInfo
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr MatchInfo -> MatchInfo
GLib.MatchInfo.MatchInfo) Ptr MatchInfo
matchInfo'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        Regex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Regex
regex
        Ptr (Ptr MatchInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr MatchInfo)
matchInfo
        (Maybe Text, MatchInfo) -> IO (Maybe Text, MatchInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
maybeResult, MatchInfo
matchInfo'')
     ) (do
        Ptr (Ptr MatchInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr MatchInfo)
matchInfo
     )

#if defined(ENABLE_OVERLOADING)
data ConfigMatchMethodInfo
instance (signature ~ (GLib.Regex.Regex -> m ((Maybe T.Text, GLib.MatchInfo.MatchInfo))), MonadIO m, IsConfig a) => O.MethodInfo ConfigMatchMethodInfo a signature where
    overloadedMethod = configMatch

#endif

-- method Config::match_foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "regex"
--           , argType = TInterface Name { namespace = "GLib" , name = "Regex" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GRegex." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "ConfigMatchCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfigMatchCallback."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the user data for @callback."
--                 , 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 "ggit_config_match_foreach" ggit_config_match_foreach :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    Ptr GLib.Regex.Regex ->                 -- regex : TInterface (Name {namespace = "GLib", name = "Regex"})
    FunPtr Ggit.Callbacks.C_ConfigMatchCallback -> -- callback : TInterface (Name {namespace = "Ggit", name = "ConfigMatchCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Call /@callback@/ for all configurations matching /@regex@/.
configMatchForeach ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> GLib.Regex.Regex
    -- ^ /@regex@/: a t'GI.GLib.Structs.Regex.Regex'.
    -> Ggit.Callbacks.ConfigMatchCallback
    -- ^ /@callback@/: a t'GI.Ggit.Callbacks.ConfigMatchCallback'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configMatchForeach :: a -> Regex -> ConfigMatchCallback -> m ()
configMatchForeach a
config Regex
regex ConfigMatchCallback
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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    Ptr Regex
regex' <- Regex -> IO (Ptr Regex)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Regex
regex
    FunPtr C_ConfigMatchCallback
callback' <- C_ConfigMatchCallback -> IO (FunPtr C_ConfigMatchCallback)
Ggit.Callbacks.mk_ConfigMatchCallback (Maybe (Ptr (FunPtr C_ConfigMatchCallback))
-> ConfigMatchCallback_WithClosures -> C_ConfigMatchCallback
Ggit.Callbacks.wrap_ConfigMatchCallback Maybe (Ptr (FunPtr C_ConfigMatchCallback))
forall a. Maybe a
Nothing (ConfigMatchCallback -> ConfigMatchCallback_WithClosures
Ggit.Callbacks.drop_closures_ConfigMatchCallback ConfigMatchCallback
callback))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    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 Config
-> Ptr Regex
-> FunPtr C_ConfigMatchCallback
-> Ptr ()
-> Ptr (Ptr GError)
-> IO CInt
ggit_config_match_foreach Ptr Config
config' Ptr Regex
regex' FunPtr C_ConfigMatchCallback
callback' Ptr ()
forall a. Ptr a
userData
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ConfigMatchCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ConfigMatchCallback
callback'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        Regex -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Regex
regex
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_ConfigMatchCallback -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_ConfigMatchCallback
callback'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ConfigMatchForeachMethodInfo
instance (signature ~ (GLib.Regex.Regex -> Ggit.Callbacks.ConfigMatchCallback -> m ()), MonadIO m, IsConfig a) => O.MethodInfo ConfigMatchForeachMethodInfo a signature where
    overloadedMethod = configMatchForeach

#endif

-- method Config::open_level
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "level"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "ConfigLevel" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the level to open." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Ggit" , name = "Config" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_config_open_level" ggit_config_open_level :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CInt ->                                 -- level : TInterface (Name {namespace = "Ggit", name = "ConfigLevel"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Config)

-- | Open a specific level config derived from a multi-level one.
configOpenLevel ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> Ggit.Enums.ConfigLevel
    -- ^ /@level@/: the level to open.
    -> m Config
    -- ^ __Returns:__ the configuration at /@level@/, or 'P.Nothing'. /(Can throw 'Data.GI.Base.GError.GError')/
configOpenLevel :: a -> ConfigLevel -> m Config
configOpenLevel a
config ConfigLevel
level = IO Config -> m Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> m Config) -> IO Config -> m Config
forall a b. (a -> b) -> a -> b
$ do
    Ptr Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    let level' :: CInt
level' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (ConfigLevel -> Int) -> ConfigLevel -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigLevel -> Int
forall a. Enum a => a -> Int
fromEnum) ConfigLevel
level
    IO Config -> IO () -> IO Config
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Config
result <- (Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config))
-> (Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config)
forall a b. (a -> b) -> a -> b
$ Ptr Config -> CInt -> Ptr (Ptr GError) -> IO (Ptr Config)
ggit_config_open_level Ptr Config
config' CInt
level'
        Text -> Ptr Config -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configOpenLevel" Ptr Config
result
        Config
result' <- ((ManagedPtr Config -> Config) -> Ptr Config -> IO Config
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Config -> Config
Config) Ptr Config
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ConfigOpenLevelMethodInfo
instance (signature ~ (Ggit.Enums.ConfigLevel -> m Config), MonadIO m, IsConfig a) => O.MethodInfo ConfigOpenLevelMethodInfo a signature where
    overloadedMethod = configOpenLevel

#endif

-- method Config::set_bool
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the configuration value."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value." , 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 "ggit_config_set_bool" ggit_config_set_bool :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    CInt ->                                 -- value : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Set a boolean value.
configSetBool ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the name of the configuration value.
    -> Bool
    -- ^ /@value@/: the new value.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configSetBool :: a -> Text -> Bool -> m ()
configSetBool a
config Text
name Bool
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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    let value' :: CInt
value' = (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
value
    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 Config -> CString -> CInt -> Ptr (Ptr GError) -> IO CInt
ggit_config_set_bool Ptr Config
config' CString
name' CInt
value'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

#if defined(ENABLE_OVERLOADING)
data ConfigSetBoolMethodInfo
instance (signature ~ (T.Text -> Bool -> m ()), MonadIO m, IsConfig a) => O.MethodInfo ConfigSetBoolMethodInfo a signature where
    overloadedMethod = configSetBool

#endif

-- method Config::set_int32
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the configuration value."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt32
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value." , 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 "ggit_config_set_int32" ggit_config_set_int32 :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    Int32 ->                                -- value : TBasicType TInt32
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Set a int32 value.
configSetInt32 ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the name of the configuration value.
    -> Int32
    -- ^ /@value@/: the new value.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configSetInt32 :: a -> Text -> Int32 -> m ()
configSetInt32 a
config Text
name Int32
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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    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 Config -> CString -> Int32 -> Ptr (Ptr GError) -> IO CInt
ggit_config_set_int32 Ptr Config
config' CString
name' Int32
value
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

#if defined(ENABLE_OVERLOADING)
data ConfigSetInt32MethodInfo
instance (signature ~ (T.Text -> Int32 -> m ()), MonadIO m, IsConfig a) => O.MethodInfo ConfigSetInt32MethodInfo a signature where
    overloadedMethod = configSetInt32

#endif

-- method Config::set_int64
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the configuration value."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "value"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new value." , 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 "ggit_config_set_int64" ggit_config_set_int64 :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    Int64 ->                                -- value : TBasicType TInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Set a int64 value.
configSetInt64 ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the name of the configuration value.
    -> Int64
    -- ^ /@value@/: the new value.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configSetInt64 :: a -> Text -> Int64 -> m ()
configSetInt64 a
config Text
name Int64
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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    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 Config -> CString -> Int64 -> Ptr (Ptr GError) -> IO CInt
ggit_config_set_int64 Ptr Config
config' CString
name' Int64
value
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

#if defined(ENABLE_OVERLOADING)
data ConfigSetInt64MethodInfo
instance (signature ~ (T.Text -> Int64 -> m ()), MonadIO m, IsConfig a) => O.MethodInfo ConfigSetInt64MethodInfo a signature where
    overloadedMethod = configSetInt64

#endif

-- method Config::set_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "config"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Config" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitConfig." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the configuration value."
--                 , 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 = Just "the new value." , 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 "ggit_config_set_string" ggit_config_set_string :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- value : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Set a new string value of a configuration.
configSetString ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> T.Text
    -- ^ /@name@/: the name of the configuration value.
    -> T.Text
    -- ^ /@value@/: the new value.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
configSetString :: a -> Text -> Text -> m ()
configSetString a
config Text
name 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 Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
value' <- Text -> IO CString
textToCString Text
value
    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 Config -> CString -> CString -> Ptr (Ptr GError) -> IO CInt
ggit_config_set_string Ptr Config
config' CString
name' CString
value'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
value'
     )

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

#endif

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

foreign import ccall "ggit_config_snapshot" ggit_config_snapshot :: 
    Ptr Config ->                           -- config : TInterface (Name {namespace = "Ggit", name = "Config"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Config)

-- | Create a snapshot of the current state of the configuration,
-- which allows you to look into a consistent view of the configuration
-- for looking up complex values (e.g. a remote, submodule).
configSnapshot ::
    (B.CallStack.HasCallStack, MonadIO m, IsConfig a) =>
    a
    -- ^ /@config@/: a t'GI.Ggit.Objects.Config.Config'.
    -> m Config
    -- ^ __Returns:__ a new t'GI.Ggit.Objects.Config.Config', or 'P.Nothing' if an error occurred. /(Can throw 'Data.GI.Base.GError.GError')/
configSnapshot :: a -> m Config
configSnapshot a
config = IO Config -> m Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> m Config) -> IO Config -> m Config
forall a b. (a -> b) -> a -> b
$ do
    Ptr Config
config' <- a -> IO (Ptr Config)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
config
    IO Config -> IO () -> IO Config
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Config
result <- (Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config))
-> (Ptr (Ptr GError) -> IO (Ptr Config)) -> IO (Ptr Config)
forall a b. (a -> b) -> a -> b
$ Ptr Config -> Ptr (Ptr GError) -> IO (Ptr Config)
ggit_config_snapshot Ptr Config
config'
        Text -> Ptr Config -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configSnapshot" Ptr Config
result
        Config
result' <- ((ManagedPtr Config -> Config) -> Ptr Config -> IO Config
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Config -> Config
Config) Ptr Config
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
config
        Config -> IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data ConfigSnapshotMethodInfo
instance (signature ~ (m Config), MonadIO m, IsConfig a) => O.MethodInfo ConfigSnapshotMethodInfo a signature where
    overloadedMethod = configSnapshot

#endif

-- method Config::find_global
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_config_find_global" ggit_config_find_global :: 
    IO (Ptr Gio.File.File)

-- | Find the file representing the users global git configuration. This file
-- is usually located at $HOME\/.gitconfig. This function will try to guess
-- the full path to that file, if the file exists. The returned file may then
-- be used with @/ggit_config_new_from_file/@ or @/ggit_config_add_file/@. This
-- function returns 'P.Nothing' if the global config could not be found.
configFindGlobal ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gio.File.File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' or 'P.Nothing' if the global config could not be found.
configFindGlobal :: m File
configFindGlobal  = 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
result <- IO (Ptr File)
ggit_config_find_global
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configFindGlobal" 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
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Config::find_system
-- method type : MemberFunction
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : False
-- Skip return : False

foreign import ccall "ggit_config_find_system" ggit_config_find_system :: 
    IO (Ptr Gio.File.File)

-- | Find the file representing the systems global git configuration. This file
-- is usually located at \/etc\/gitconfig on UNIX type systems or
-- @/PROGRAMFILES/@%\\Git\\etc\\gitconfig on windows. This function will try to guess
-- the full path to that file, if the file exists. The returned file may then
-- be used with @/ggit_config_new_from_file/@ or @/ggit_config_add_file/@. This
-- function returns 'P.Nothing' if the system config could not be found.
configFindSystem ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Gio.File.File
    -- ^ __Returns:__ a t'GI.Gio.Interfaces.File.File' or 'P.Nothing' if the system config could not
    --                           be found.
configFindSystem :: m File
configFindSystem  = 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
result <- IO (Ptr File)
ggit_config_find_system
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"configFindSystem" 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
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
#endif