{-# LANGUAGE TypeApplications #-}


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

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

module GI.Ggit.Structs.Submodule
    ( 

-- * Exported types
    Submodule(..)                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [init]("GI.Ggit.Structs.Submodule#g:method:init"), [open]("GI.Ggit.Structs.Submodule#g:method:open"), [ref]("GI.Ggit.Structs.Submodule#g:method:ref"), [reload]("GI.Ggit.Structs.Submodule#g:method:reload"), [sync]("GI.Ggit.Structs.Submodule#g:method:sync"), [unref]("GI.Ggit.Structs.Submodule#g:method:unref"), [update]("GI.Ggit.Structs.Submodule#g:method:update").
-- 
-- ==== Getters
-- [getFetchRecurse]("GI.Ggit.Structs.Submodule#g:method:getFetchRecurse"), [getHeadId]("GI.Ggit.Structs.Submodule#g:method:getHeadId"), [getIgnore]("GI.Ggit.Structs.Submodule#g:method:getIgnore"), [getIndexId]("GI.Ggit.Structs.Submodule#g:method:getIndexId"), [getName]("GI.Ggit.Structs.Submodule#g:method:getName"), [getOwner]("GI.Ggit.Structs.Submodule#g:method:getOwner"), [getPath]("GI.Ggit.Structs.Submodule#g:method:getPath"), [getUpdate]("GI.Ggit.Structs.Submodule#g:method:getUpdate"), [getUrl]("GI.Ggit.Structs.Submodule#g:method:getUrl"), [getWorkdirId]("GI.Ggit.Structs.Submodule#g:method:getWorkdirId").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveSubmoduleMethod                  ,
#endif

-- ** getFetchRecurse #method:getFetchRecurse#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetFetchRecurseMethodInfo      ,
#endif
    submoduleGetFetchRecurse                ,


-- ** getHeadId #method:getHeadId#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetHeadIdMethodInfo            ,
#endif
    submoduleGetHeadId                      ,


-- ** getIgnore #method:getIgnore#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetIgnoreMethodInfo            ,
#endif
    submoduleGetIgnore                      ,


-- ** getIndexId #method:getIndexId#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetIndexIdMethodInfo           ,
#endif
    submoduleGetIndexId                     ,


-- ** getName #method:getName#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetNameMethodInfo              ,
#endif
    submoduleGetName                        ,


-- ** getOwner #method:getOwner#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetOwnerMethodInfo             ,
#endif
    submoduleGetOwner                       ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetPathMethodInfo              ,
#endif
    submoduleGetPath                        ,


-- ** getUpdate #method:getUpdate#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetUpdateMethodInfo            ,
#endif
    submoduleGetUpdate                      ,


-- ** getUrl #method:getUrl#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetUrlMethodInfo               ,
#endif
    submoduleGetUrl                         ,


-- ** getWorkdirId #method:getWorkdirId#

#if defined(ENABLE_OVERLOADING)
    SubmoduleGetWorkdirIdMethodInfo         ,
#endif
    submoduleGetWorkdirId                   ,


-- ** init #method:init#

#if defined(ENABLE_OVERLOADING)
    SubmoduleInitMethodInfo                 ,
#endif
    submoduleInit                           ,


-- ** open #method:open#

#if defined(ENABLE_OVERLOADING)
    SubmoduleOpenMethodInfo                 ,
#endif
    submoduleOpen                           ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    SubmoduleRefMethodInfo                  ,
#endif
    submoduleRef                            ,


-- ** reload #method:reload#

#if defined(ENABLE_OVERLOADING)
    SubmoduleReloadMethodInfo               ,
#endif
    submoduleReload                         ,


-- ** sync #method:sync#

#if defined(ENABLE_OVERLOADING)
    SubmoduleSyncMethodInfo                 ,
#endif
    submoduleSync                           ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    SubmoduleUnrefMethodInfo                ,
#endif
    submoduleUnref                          ,


-- ** update #method:update#

#if defined(ENABLE_OVERLOADING)
    SubmoduleUpdateMethodInfo               ,
#endif
    submoduleUpdate                         ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Ggit.Enums as Ggit.Enums
import {-# SOURCE #-} qualified GI.Ggit.Objects.Repository as Ggit.Repository
import {-# SOURCE #-} qualified GI.Ggit.Objects.SubmoduleUpdateOptions as Ggit.SubmoduleUpdateOptions
import {-# SOURCE #-} qualified GI.Ggit.Structs.OId as Ggit.OId

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

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

foreign import ccall "ggit_submodule_get_type" c_ggit_submodule_get_type :: 
    IO GType

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

instance B.Types.TypedObject Submodule where
    glibType :: IO GType
glibType = IO GType
c_ggit_submodule_get_type

instance B.Types.GBoxed Submodule

-- | Convert 'Submodule' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Submodule) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_ggit_submodule_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Submodule -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Submodule
P.Nothing = Ptr GValue -> Ptr Submodule -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Submodule
forall a. Ptr a
FP.nullPtr :: FP.Ptr Submodule)
    gvalueSet_ Ptr GValue
gv (P.Just Submodule
obj) = Submodule -> (Ptr Submodule -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Submodule
obj (Ptr GValue -> Ptr Submodule -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Submodule)
gvalueGet_ Ptr GValue
gv = do
        Ptr Submodule
ptr <- Ptr GValue -> IO (Ptr Submodule)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Submodule)
        if Ptr Submodule
ptr Ptr Submodule -> Ptr Submodule -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Submodule
forall a. Ptr a
FP.nullPtr
        then Submodule -> Maybe Submodule
forall a. a -> Maybe a
P.Just (Submodule -> Maybe Submodule)
-> IO Submodule -> IO (Maybe Submodule)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Submodule -> Submodule)
-> Ptr Submodule -> IO Submodule
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Submodule -> Submodule
Submodule Ptr Submodule
ptr
        else Maybe Submodule -> IO (Maybe Submodule)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Submodule
forall a. Maybe a
P.Nothing
        
    


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

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

foreign import ccall "ggit_submodule_get_fetch_recurse" ggit_submodule_get_fetch_recurse :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO CInt

-- | Gets whether to fetch recursively. See see gitmodules(5) fetchRecurseSubmodules.
submoduleGetFetchRecurse ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m Bool
    -- ^ __Returns:__ whether or not fetch recursively.
submoduleGetFetchRecurse :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m Bool
submoduleGetFetchRecurse Submodule
submodule = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    CInt
result <- Ptr Submodule -> IO CInt
ggit_submodule_get_fetch_recurse Ptr Submodule
submodule'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetFetchRecurseMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod SubmoduleGetFetchRecurseMethodInfo Submodule signature where
    overloadedMethod = submoduleGetFetchRecurse

instance O.OverloadedMethodInfo SubmoduleGetFetchRecurseMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetFetchRecurse",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetFetchRecurse"
        })


#endif

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

foreign import ccall "ggit_submodule_get_head_id" ggit_submodule_get_head_id :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO (Ptr Ggit.OId.OId)

-- | /No description available in the introspection data./
submoduleGetHeadId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -> m Ggit.OId.OId
submoduleGetHeadId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m OId
submoduleGetHeadId Submodule
submodule = IO OId -> m OId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO OId -> m OId) -> IO OId -> m OId
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    Ptr OId
result <- Ptr Submodule -> IO (Ptr OId)
ggit_submodule_get_head_id Ptr Submodule
submodule'
    Text -> Ptr OId -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"submoduleGetHeadId" Ptr OId
result
    OId
result' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result'

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetHeadIdMethodInfo
instance (signature ~ (m Ggit.OId.OId), MonadIO m) => O.OverloadedMethod SubmoduleGetHeadIdMethodInfo Submodule signature where
    overloadedMethod = submoduleGetHeadId

instance O.OverloadedMethodInfo SubmoduleGetHeadIdMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetHeadId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetHeadId"
        })


#endif

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

foreign import ccall "ggit_submodule_get_ignore" ggit_submodule_get_ignore :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO CInt

-- | Gets a t'GI.Ggit.Enums.SubmoduleIgnore'. See see gitmodules(5) ignore.
submoduleGetIgnore ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m Ggit.Enums.SubmoduleIgnore
    -- ^ __Returns:__ the t'GI.Ggit.Enums.SubmoduleIgnore'.
submoduleGetIgnore :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m SubmoduleIgnore
submoduleGetIgnore Submodule
submodule = IO SubmoduleIgnore -> m SubmoduleIgnore
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SubmoduleIgnore -> m SubmoduleIgnore)
-> IO SubmoduleIgnore -> m SubmoduleIgnore
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    CInt
result <- Ptr Submodule -> IO CInt
ggit_submodule_get_ignore Ptr Submodule
submodule'
    let result' :: SubmoduleIgnore
result' = (Int -> SubmoduleIgnore
forall a. Enum a => Int -> a
toEnum (Int -> SubmoduleIgnore)
-> (CInt -> Int) -> CInt -> SubmoduleIgnore
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CInt
result
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    SubmoduleIgnore -> IO SubmoduleIgnore
forall (m :: * -> *) a. Monad m => a -> m a
return SubmoduleIgnore
result'

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetIgnoreMethodInfo
instance (signature ~ (m Ggit.Enums.SubmoduleIgnore), MonadIO m) => O.OverloadedMethod SubmoduleGetIgnoreMethodInfo Submodule signature where
    overloadedMethod = submoduleGetIgnore

instance O.OverloadedMethodInfo SubmoduleGetIgnoreMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetIgnore",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetIgnore"
        })


#endif

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

foreign import ccall "ggit_submodule_get_index_id" ggit_submodule_get_index_id :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO (Ptr Ggit.OId.OId)

-- | Gets the OID for the submodule in the index or 'P.Nothing' if there is no index.
submoduleGetIndexId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the OID for the submodule in the index or 'P.Nothing'.
submoduleGetIndexId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m (Maybe OId)
submoduleGetIndexId Submodule
submodule = IO (Maybe OId) -> m (Maybe OId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    Ptr OId
result <- Ptr Submodule -> IO (Ptr OId)
ggit_submodule_get_index_id Ptr Submodule
submodule'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetIndexIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod SubmoduleGetIndexIdMethodInfo Submodule signature where
    overloadedMethod = submoduleGetIndexId

instance O.OverloadedMethodInfo SubmoduleGetIndexIdMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetIndexId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetIndexId"
        })


#endif

-- method Submodule::get_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "submodule"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Submodule" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmodule." , 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 "ggit_submodule_get_name" ggit_submodule_get_name :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO CString

-- | Gets the name of the submodule from .gitmodules.
submoduleGetName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of the submodule from .gitmodules or 'P.Nothing'.
submoduleGetName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m (Maybe Text)
submoduleGetName Submodule
submodule = 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 Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    CString
result <- Ptr Submodule -> IO CString
ggit_submodule_get_name Ptr Submodule
submodule'
    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''
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetNameMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod SubmoduleGetNameMethodInfo Submodule signature where
    overloadedMethod = submoduleGetName

instance O.OverloadedMethodInfo SubmoduleGetNameMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetName",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetName"
        })


#endif

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

foreign import ccall "ggit_submodule_get_owner" ggit_submodule_get_owner :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO (Ptr Ggit.Repository.Repository)

-- | Gets the containing repository for a submodule.
submoduleGetOwner ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m (Maybe Ggit.Repository.Repository)
    -- ^ __Returns:__ the containing repository for a submodule or 'P.Nothing'.
submoduleGetOwner :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m (Maybe Repository)
submoduleGetOwner Submodule
submodule = IO (Maybe Repository) -> m (Maybe Repository)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Repository) -> m (Maybe Repository))
-> IO (Maybe Repository) -> m (Maybe Repository)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    Ptr Repository
result <- Ptr Submodule -> IO (Ptr Repository)
ggit_submodule_get_owner Ptr Submodule
submodule'
    Maybe Repository
maybeResult <- Ptr Repository
-> (Ptr Repository -> IO Repository) -> IO (Maybe Repository)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Repository
result ((Ptr Repository -> IO Repository) -> IO (Maybe Repository))
-> (Ptr Repository -> IO Repository) -> IO (Maybe Repository)
forall a b. (a -> b) -> a -> b
$ \Ptr Repository
result' -> do
        Repository
result'' <- ((ManagedPtr Repository -> Repository)
-> Ptr Repository -> IO Repository
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repository -> Repository
Ggit.Repository.Repository) Ptr Repository
result'
        Repository -> IO Repository
forall (m :: * -> *) a. Monad m => a -> m a
return Repository
result''
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    Maybe Repository -> IO (Maybe Repository)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Repository
maybeResult

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetOwnerMethodInfo
instance (signature ~ (m (Maybe Ggit.Repository.Repository)), MonadIO m) => O.OverloadedMethod SubmoduleGetOwnerMethodInfo Submodule signature where
    overloadedMethod = submoduleGetOwner

instance O.OverloadedMethodInfo SubmoduleGetOwnerMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetOwner",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetOwner"
        })


#endif

-- method Submodule::get_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "submodule"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Submodule" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmodule." , 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 "ggit_submodule_get_path" ggit_submodule_get_path :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO CString

-- | Gets the path to the submodule from the repo working directory.
-- It is almost always the same as the name.
-- See 'GI.Ggit.Structs.Submodule.submoduleGetName'.
submoduleGetPath ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the path to the submodule from
    -- the repo working directory or 'P.Nothing'.
submoduleGetPath :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m (Maybe Text)
submoduleGetPath Submodule
submodule = 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 Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    CString
result <- Ptr Submodule -> IO CString
ggit_submodule_get_path Ptr Submodule
submodule'
    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''
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetPathMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod SubmoduleGetPathMethodInfo Submodule signature where
    overloadedMethod = submoduleGetPath

instance O.OverloadedMethodInfo SubmoduleGetPathMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetPath",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetPath"
        })


#endif

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

foreign import ccall "ggit_submodule_get_update" ggit_submodule_get_update :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO CUInt

-- | Gets a t'GI.Ggit.Enums.SubmoduleUpdate'. See see gitmodules(5) update.
submoduleGetUpdate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m Ggit.Enums.SubmoduleUpdate
    -- ^ __Returns:__ the t'GI.Ggit.Enums.SubmoduleUpdate'.
submoduleGetUpdate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m SubmoduleUpdate
submoduleGetUpdate Submodule
submodule = IO SubmoduleUpdate -> m SubmoduleUpdate
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SubmoduleUpdate -> m SubmoduleUpdate)
-> IO SubmoduleUpdate -> m SubmoduleUpdate
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    CUInt
result <- Ptr Submodule -> IO CUInt
ggit_submodule_get_update Ptr Submodule
submodule'
    let result' :: SubmoduleUpdate
result' = (Int -> SubmoduleUpdate
forall a. Enum a => Int -> a
toEnum (Int -> SubmoduleUpdate)
-> (CUInt -> Int) -> CUInt -> SubmoduleUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    SubmoduleUpdate -> IO SubmoduleUpdate
forall (m :: * -> *) a. Monad m => a -> m a
return SubmoduleUpdate
result'

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetUpdateMethodInfo
instance (signature ~ (m Ggit.Enums.SubmoduleUpdate), MonadIO m) => O.OverloadedMethod SubmoduleGetUpdateMethodInfo Submodule signature where
    overloadedMethod = submoduleGetUpdate

instance O.OverloadedMethodInfo SubmoduleGetUpdateMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetUpdate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetUpdate"
        })


#endif

-- method Submodule::get_url
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "submodule"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Submodule" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmodule." , 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 "ggit_submodule_get_url" ggit_submodule_get_url :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO CString

-- | Gets the url for the submodule or 'P.Nothing' if the submodule has been deleted
-- but not yet committed.
submoduleGetUrl ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the url for the submodule or 'P.Nothing'.
submoduleGetUrl :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m (Maybe Text)
submoduleGetUrl Submodule
submodule = 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 Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    CString
result <- Ptr Submodule -> IO CString
ggit_submodule_get_url Ptr Submodule
submodule'
    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''
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetUrlMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod SubmoduleGetUrlMethodInfo Submodule signature where
    overloadedMethod = submoduleGetUrl

instance O.OverloadedMethodInfo SubmoduleGetUrlMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetUrl",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetUrl"
        })


#endif

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

foreign import ccall "ggit_submodule_get_workdir_id" ggit_submodule_get_workdir_id :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO (Ptr Ggit.OId.OId)

-- | Gets the OID for the submodule in the current working directory.
-- Corresponds to looking up \'HEAD\' in the checked out submodule.
-- If there are pending changes in the index or anything
-- else, this won\'t notice that.  You should call @/ggit_submodule_status()/@
-- for a more complete picture about the state of the working directory.
submoduleGetWorkdirId ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m (Maybe Ggit.OId.OId)
    -- ^ __Returns:__ the OID for the submodule in the current working directory or 'P.Nothing'.
submoduleGetWorkdirId :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m (Maybe OId)
submoduleGetWorkdirId Submodule
submodule = IO (Maybe OId) -> m (Maybe OId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe OId) -> m (Maybe OId))
-> IO (Maybe OId) -> m (Maybe OId)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    Ptr OId
result <- Ptr Submodule -> IO (Ptr OId)
ggit_submodule_get_workdir_id Ptr Submodule
submodule'
    Maybe OId
maybeResult <- Ptr OId -> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr OId
result ((Ptr OId -> IO OId) -> IO (Maybe OId))
-> (Ptr OId -> IO OId) -> IO (Maybe OId)
forall a b. (a -> b) -> a -> b
$ \Ptr OId
result' -> do
        OId
result'' <- ((ManagedPtr OId -> OId) -> Ptr OId -> IO OId
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr OId -> OId
Ggit.OId.OId) Ptr OId
result'
        OId -> IO OId
forall (m :: * -> *) a. Monad m => a -> m a
return OId
result''
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    Maybe OId -> IO (Maybe OId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe OId
maybeResult

#if defined(ENABLE_OVERLOADING)
data SubmoduleGetWorkdirIdMethodInfo
instance (signature ~ (m (Maybe Ggit.OId.OId)), MonadIO m) => O.OverloadedMethod SubmoduleGetWorkdirIdMethodInfo Submodule signature where
    overloadedMethod = submoduleGetWorkdirId

instance O.OverloadedMethodInfo SubmoduleGetWorkdirIdMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleGetWorkdirId",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleGetWorkdirId"
        })


#endif

-- method Submodule::init
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "submodule"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Submodule" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmodule." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "overwrite"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "forces existing entries to be updated."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_submodule_init" ggit_submodule_init :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    CInt ->                                 -- overwrite : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Just like \"git submodule init\", this copies information about the
-- submodule into \".git\/config\".  You can use the accessor functions
-- above to alter the in-memory git_submodule object and control what
-- is written to the config, overriding what is in .gitmodules.
submoduleInit ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> Bool
    -- ^ /@overwrite@/: forces existing entries to be updated.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
submoduleInit :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> Bool -> m ()
submoduleInit Submodule
submodule Bool
overwrite = 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 Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    let overwrite' :: CInt
overwrite' = (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
overwrite
    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 Submodule -> CInt -> Ptr (Ptr GError) -> IO ()
ggit_submodule_init Ptr Submodule
submodule' CInt
overwrite'
        Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
        () -> 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 SubmoduleInitMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod SubmoduleInitMethodInfo Submodule signature where
    overloadedMethod = submoduleInit

instance O.OverloadedMethodInfo SubmoduleInitMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleInit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleInit"
        })


#endif

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

foreign import ccall "ggit_submodule_open" ggit_submodule_open :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Ggit.Repository.Repository)

-- | Open the repository for a submodule. Multiple calls to this function
-- will return distinct t'GI.Ggit.Objects.Repository.Repository' objects. Only submodules which are
-- checked out in the working directory can be opened.
submoduleOpen ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m (Maybe Ggit.Repository.Repository)
    -- ^ __Returns:__ the opened t'GI.Ggit.Objects.Repository.Repository' or 'P.Nothing' in case of an
    --                           error. /(Can throw 'Data.GI.Base.GError.GError')/
submoduleOpen :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m (Maybe Repository)
submoduleOpen Submodule
submodule = IO (Maybe Repository) -> m (Maybe Repository)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Repository) -> m (Maybe Repository))
-> IO (Maybe Repository) -> m (Maybe Repository)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    IO (Maybe Repository) -> IO () -> IO (Maybe Repository)
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Repository
result <- (Ptr (Ptr GError) -> IO (Ptr Repository)) -> IO (Ptr Repository)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Repository)) -> IO (Ptr Repository))
-> (Ptr (Ptr GError) -> IO (Ptr Repository)) -> IO (Ptr Repository)
forall a b. (a -> b) -> a -> b
$ Ptr Submodule -> Ptr (Ptr GError) -> IO (Ptr Repository)
ggit_submodule_open Ptr Submodule
submodule'
        Maybe Repository
maybeResult <- Ptr Repository
-> (Ptr Repository -> IO Repository) -> IO (Maybe Repository)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Repository
result ((Ptr Repository -> IO Repository) -> IO (Maybe Repository))
-> (Ptr Repository -> IO Repository) -> IO (Maybe Repository)
forall a b. (a -> b) -> a -> b
$ \Ptr Repository
result' -> do
            Repository
result'' <- ((ManagedPtr Repository -> Repository)
-> Ptr Repository -> IO Repository
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repository -> Repository
Ggit.Repository.Repository) Ptr Repository
result'
            Repository -> IO Repository
forall (m :: * -> *) a. Monad m => a -> m a
return Repository
result''
        Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
        Maybe Repository -> IO (Maybe Repository)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Repository
maybeResult
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data SubmoduleOpenMethodInfo
instance (signature ~ (m (Maybe Ggit.Repository.Repository)), MonadIO m) => O.OverloadedMethod SubmoduleOpenMethodInfo Submodule signature where
    overloadedMethod = submoduleOpen

instance O.OverloadedMethodInfo SubmoduleOpenMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleOpen",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleOpen"
        })


#endif

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

foreign import ccall "ggit_submodule_ref" ggit_submodule_ref :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO (Ptr Submodule)

-- | Atomically increments the reference count of /@submodule@/ by one.
-- This function is MT-safe and may be called from any thread.
submoduleRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m (Maybe Submodule)
    -- ^ __Returns:__ the passed in t'GI.Ggit.Structs.Submodule.Submodule' or 'P.Nothing'.
submoduleRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m (Maybe Submodule)
submoduleRef Submodule
submodule = IO (Maybe Submodule) -> m (Maybe Submodule)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Submodule) -> m (Maybe Submodule))
-> IO (Maybe Submodule) -> m (Maybe Submodule)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    Ptr Submodule
result <- Ptr Submodule -> IO (Ptr Submodule)
ggit_submodule_ref Ptr Submodule
submodule'
    Maybe Submodule
maybeResult <- Ptr Submodule
-> (Ptr Submodule -> IO Submodule) -> IO (Maybe Submodule)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Submodule
result ((Ptr Submodule -> IO Submodule) -> IO (Maybe Submodule))
-> (Ptr Submodule -> IO Submodule) -> IO (Maybe Submodule)
forall a b. (a -> b) -> a -> b
$ \Ptr Submodule
result' -> do
        Submodule
result'' <- ((ManagedPtr Submodule -> Submodule)
-> Ptr Submodule -> IO Submodule
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Submodule -> Submodule
Submodule) Ptr Submodule
result'
        Submodule -> IO Submodule
forall (m :: * -> *) a. Monad m => a -> m a
return Submodule
result''
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    Maybe Submodule -> IO (Maybe Submodule)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Submodule
maybeResult

#if defined(ENABLE_OVERLOADING)
data SubmoduleRefMethodInfo
instance (signature ~ (m (Maybe Submodule)), MonadIO m) => O.OverloadedMethod SubmoduleRefMethodInfo Submodule signature where
    overloadedMethod = submoduleRef

instance O.OverloadedMethodInfo SubmoduleRefMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleRef"
        })


#endif

-- method Submodule::reload
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "submodule"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Submodule" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmodule." , 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 "reload even if the data doesn't seem out of date."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_submodule_reload" ggit_submodule_reload :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    CInt ->                                 -- force : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Rereads submodule info from config, index, and HEAD.
-- Call this if you have reason to believe that it has changed.
submoduleReload ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> Bool
    -- ^ /@force@/: reload even if the data doesn\'t seem out of date.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
submoduleReload :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> Bool -> m ()
submoduleReload Submodule
submodule 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 Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    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 Submodule -> CInt -> Ptr (Ptr GError) -> IO ()
ggit_submodule_reload Ptr Submodule
submodule' CInt
force'
        Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
        () -> 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 SubmoduleReloadMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.OverloadedMethod SubmoduleReloadMethodInfo Submodule signature where
    overloadedMethod = submoduleReload

instance O.OverloadedMethodInfo SubmoduleReloadMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleReload",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleReload"
        })


#endif

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

foreign import ccall "ggit_submodule_sync" ggit_submodule_sync :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Copies the information about the submodules URL into the checked out
-- submodule config, acting like \"git submodule sync\".  This is useful if
-- you have altered the URL for the submodule (or it has been altered by a
-- fetch of upstream changes) and you need to update your local repo.
submoduleSync ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
submoduleSync :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m ()
submoduleSync Submodule
submodule = 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 Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    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 Submodule -> Ptr (Ptr GError) -> IO ()
ggit_submodule_sync Ptr Submodule
submodule'
        Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
        () -> 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 SubmoduleSyncMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod SubmoduleSyncMethodInfo Submodule signature where
    overloadedMethod = submoduleSync

instance O.OverloadedMethodInfo SubmoduleSyncMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleSync",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleSync"
        })


#endif

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

foreign import ccall "ggit_submodule_unref" ggit_submodule_unref :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    IO ()

-- | Atomically decrements the reference count of /@submodule@/ by one.
-- If the reference count drops to 0, /@remote@/ is freed.
submoduleUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> m ()
submoduleUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Submodule -> m ()
submoduleUnref Submodule
submodule = 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 Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    Ptr Submodule -> IO ()
ggit_submodule_unref Ptr Submodule
submodule'
    Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data SubmoduleUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod SubmoduleUnrefMethodInfo Submodule signature where
    overloadedMethod = submoduleUnref

instance O.OverloadedMethodInfo SubmoduleUnrefMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleUnref"
        })


#endif

-- method Submodule::update
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "submodule"
--           , argType =
--               TInterface Name { namespace = "Ggit" , name = "Submodule" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmodule." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "init"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "If the submodule is not initialized, setting this flag to true\n       will initialize the submodule before updating. Otherwise, this\n       will return an error if attempting to update an uninitialzed\n       repository. but setting this to true forces them to be updated."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "SubmoduleUpdateOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GgitSubmoduleUpdateOptions object."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : True
-- Skip return : False

foreign import ccall "ggit_submodule_update" ggit_submodule_update :: 
    Ptr Submodule ->                        -- submodule : TInterface (Name {namespace = "Ggit", name = "Submodule"})
    CInt ->                                 -- init : TBasicType TBoolean
    Ptr Ggit.SubmoduleUpdateOptions.SubmoduleUpdateOptions -> -- options : TInterface (Name {namespace = "Ggit", name = "SubmoduleUpdateOptions"})
    Ptr (Ptr GError) ->                     -- error
    IO ()

-- | Update a submodule. This will clone a missing submodule and checkout
-- the subrepository to the commit specified in the index of the containing
-- repository. If the submodule repository doesn\'t contain the target commit
-- (e.g. because fetchRecurseSubmodules isn\'t set), then the submodule is
-- fetched using the fetch options supplied in options.
submoduleUpdate ::
    (B.CallStack.HasCallStack, MonadIO m, Ggit.SubmoduleUpdateOptions.IsSubmoduleUpdateOptions a) =>
    Submodule
    -- ^ /@submodule@/: a t'GI.Ggit.Structs.Submodule.Submodule'.
    -> Bool
    -- ^ /@init@/: If the submodule is not initialized, setting this flag to true
    --        will initialize the submodule before updating. Otherwise, this
    --        will return an error if attempting to update an uninitialzed
    --        repository. but setting this to true forces them to be updated.
    -> a
    -- ^ /@options@/: a t'GI.Ggit.Objects.SubmoduleUpdateOptions.SubmoduleUpdateOptions' object.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
submoduleUpdate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsSubmoduleUpdateOptions a) =>
Submodule -> Bool -> a -> m ()
submoduleUpdate Submodule
submodule Bool
init a
options = 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 Submodule
submodule' <- Submodule -> IO (Ptr Submodule)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Submodule
submodule
    let init' :: CInt
init' = (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
init
    Ptr SubmoduleUpdateOptions
options' <- a -> IO (Ptr SubmoduleUpdateOptions)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
options
    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 Submodule
-> CInt -> Ptr SubmoduleUpdateOptions -> Ptr (Ptr GError) -> IO ()
ggit_submodule_update Ptr Submodule
submodule' CInt
init' Ptr SubmoduleUpdateOptions
options'
        Submodule -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Submodule
submodule
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
options
        () -> 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 SubmoduleUpdateMethodInfo
instance (signature ~ (Bool -> a -> m ()), MonadIO m, Ggit.SubmoduleUpdateOptions.IsSubmoduleUpdateOptions a) => O.OverloadedMethod SubmoduleUpdateMethodInfo Submodule signature where
    overloadedMethod = submoduleUpdate

instance O.OverloadedMethodInfo SubmoduleUpdateMethodInfo Submodule where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Structs.Submodule.submoduleUpdate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Structs-Submodule.html#v:submoduleUpdate"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveSubmoduleMethod (t :: Symbol) (o :: *) :: * where
    ResolveSubmoduleMethod "init" o = SubmoduleInitMethodInfo
    ResolveSubmoduleMethod "open" o = SubmoduleOpenMethodInfo
    ResolveSubmoduleMethod "ref" o = SubmoduleRefMethodInfo
    ResolveSubmoduleMethod "reload" o = SubmoduleReloadMethodInfo
    ResolveSubmoduleMethod "sync" o = SubmoduleSyncMethodInfo
    ResolveSubmoduleMethod "unref" o = SubmoduleUnrefMethodInfo
    ResolveSubmoduleMethod "update" o = SubmoduleUpdateMethodInfo
    ResolveSubmoduleMethod "getFetchRecurse" o = SubmoduleGetFetchRecurseMethodInfo
    ResolveSubmoduleMethod "getHeadId" o = SubmoduleGetHeadIdMethodInfo
    ResolveSubmoduleMethod "getIgnore" o = SubmoduleGetIgnoreMethodInfo
    ResolveSubmoduleMethod "getIndexId" o = SubmoduleGetIndexIdMethodInfo
    ResolveSubmoduleMethod "getName" o = SubmoduleGetNameMethodInfo
    ResolveSubmoduleMethod "getOwner" o = SubmoduleGetOwnerMethodInfo
    ResolveSubmoduleMethod "getPath" o = SubmoduleGetPathMethodInfo
    ResolveSubmoduleMethod "getUpdate" o = SubmoduleGetUpdateMethodInfo
    ResolveSubmoduleMethod "getUrl" o = SubmoduleGetUrlMethodInfo
    ResolveSubmoduleMethod "getWorkdirId" o = SubmoduleGetWorkdirIdMethodInfo
    ResolveSubmoduleMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveSubmoduleMethod t Submodule, O.OverloadedMethod info Submodule p, R.HasField t Submodule p) => R.HasField t Submodule p where
    getField = O.overloadedMethod @info

#endif

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

#endif