{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- An opaque context struct for @GtkBuildableParser@.

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

module GI.Gtk.Structs.BuildableParseContext
    ( 

-- * Exported types
    BuildableParseContext(..)               ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [pop]("GI.Gtk.Structs.BuildableParseContext#g:method:pop"), [push]("GI.Gtk.Structs.BuildableParseContext#g:method:push").
-- 
-- ==== Getters
-- [getElement]("GI.Gtk.Structs.BuildableParseContext#g:method:getElement"), [getElementStack]("GI.Gtk.Structs.BuildableParseContext#g:method:getElementStack"), [getPosition]("GI.Gtk.Structs.BuildableParseContext#g:method:getPosition").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveBuildableParseContextMethod      ,
#endif

-- ** getElement #method:getElement#

#if defined(ENABLE_OVERLOADING)
    BuildableParseContextGetElementMethodInfo,
#endif
    buildableParseContextGetElement         ,


-- ** getElementStack #method:getElementStack#

#if defined(ENABLE_OVERLOADING)
    BuildableParseContextGetElementStackMethodInfo,
#endif
    buildableParseContextGetElementStack    ,


-- ** getPosition #method:getPosition#

#if defined(ENABLE_OVERLOADING)
    BuildableParseContextGetPositionMethodInfo,
#endif
    buildableParseContextGetPosition        ,


-- ** pop #method:pop#

#if defined(ENABLE_OVERLOADING)
    BuildableParseContextPopMethodInfo      ,
#endif
    buildableParseContextPop                ,


-- ** push #method:push#

#if defined(ENABLE_OVERLOADING)
    BuildableParseContextPushMethodInfo     ,
#endif
    buildableParseContextPush               ,




    ) where

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

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

import {-# SOURCE #-} qualified GI.Gtk.Structs.BuildableParser as Gtk.BuildableParser

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

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

-- XXX Wrapping a foreign struct/union with no known destructor or size, leak?
instance BoxedPtr BuildableParseContext where
    boxedPtrCopy :: BuildableParseContext -> IO BuildableParseContext
boxedPtrCopy = BuildableParseContext -> IO BuildableParseContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    boxedPtrFree :: BuildableParseContext -> IO ()
boxedPtrFree = \BuildableParseContext
_x -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


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

-- method BuildableParseContext::get_element
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "BuildableParseContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkBuildablParseContext`"
--                 , 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 "gtk_buildable_parse_context_get_element" gtk_buildable_parse_context_get_element :: 
    Ptr BuildableParseContext ->            -- context : TInterface (Name {namespace = "Gtk", name = "BuildableParseContext"})
    IO CString

-- | Retrieves the name of the currently open element.
-- 
-- If called from the start_element or end_element handlers this will
-- give the element_name as passed to those functions. For the parent
-- elements, see 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextGetElementStack'.
buildableParseContextGetElement ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BuildableParseContext
    -- ^ /@context@/: a @GtkBuildablParseContext@
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the name of the currently open element
buildableParseContextGetElement :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BuildableParseContext -> m (Maybe Text)
buildableParseContextGetElement BuildableParseContext
context = IO (Maybe Text) -> m (Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BuildableParseContext
context' <- BuildableParseContext -> IO (Ptr BuildableParseContext)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BuildableParseContext
context
    CString
result <- Ptr BuildableParseContext -> IO CString
gtk_buildable_parse_context_get_element Ptr BuildableParseContext
context'
    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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    BuildableParseContext -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BuildableParseContext
context
    Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data BuildableParseContextGetElementMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.OverloadedMethod BuildableParseContextGetElementMethodInfo BuildableParseContext signature where
    overloadedMethod = buildableParseContextGetElement

instance O.OverloadedMethodInfo BuildableParseContextGetElementMethodInfo BuildableParseContext where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.BuildableParseContext.buildableParseContextGetElement",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Structs-BuildableParseContext.html#v:buildableParseContextGetElement"
        })


#endif

-- method BuildableParseContext::get_element_stack
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "BuildableParseContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkBuildableParseContext`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TPtrArray (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gtk_buildable_parse_context_get_element_stack" gtk_buildable_parse_context_get_element_stack :: 
    Ptr BuildableParseContext ->            -- context : TInterface (Name {namespace = "Gtk", name = "BuildableParseContext"})
    IO (Ptr (GPtrArray CString))

-- | Retrieves the element stack from the internal state of the parser.
-- 
-- The returned @GPtrArray@ is an array of strings where the last item is
-- the currently open tag (as would be returned by
-- 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextGetElement') and the previous item is its
-- immediate parent.
-- 
-- This function is intended to be used in the start_element and
-- end_element handlers where 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextGetElement'
-- would merely return the name of the element that is being
-- processed.
buildableParseContextGetElementStack ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BuildableParseContext
    -- ^ /@context@/: a @GtkBuildableParseContext@
    -> m [T.Text]
    -- ^ __Returns:__ the element stack, which must not be modified
buildableParseContextGetElementStack :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BuildableParseContext -> m [Text]
buildableParseContextGetElementStack BuildableParseContext
context = IO [Text] -> m [Text]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr BuildableParseContext
context' <- BuildableParseContext -> IO (Ptr BuildableParseContext)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BuildableParseContext
context
    Ptr (GPtrArray CString)
result <- Ptr BuildableParseContext -> IO (Ptr (GPtrArray CString))
gtk_buildable_parse_context_get_element_stack Ptr BuildableParseContext
context'
    Text -> Ptr (GPtrArray CString) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"buildableParseContextGetElementStack" Ptr (GPtrArray CString)
result
    [CString]
result' <- Ptr (GPtrArray CString) -> IO [CString]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    BuildableParseContext -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BuildableParseContext
context
    [Text] -> IO [Text]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data BuildableParseContextGetElementStackMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m) => O.OverloadedMethod BuildableParseContextGetElementStackMethodInfo BuildableParseContext signature where
    overloadedMethod = buildableParseContextGetElementStack

instance O.OverloadedMethodInfo BuildableParseContextGetElementStackMethodInfo BuildableParseContext where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.BuildableParseContext.buildableParseContextGetElementStack",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Structs-BuildableParseContext.html#v:buildableParseContextGetElementStack"
        })


#endif

-- method BuildableParseContext::get_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "BuildableParseContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkBuildableParseContext`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_number"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a line number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "char_number"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for a char-on-line number"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_buildable_parse_context_get_position" gtk_buildable_parse_context_get_position :: 
    Ptr BuildableParseContext ->            -- context : TInterface (Name {namespace = "Gtk", name = "BuildableParseContext"})
    Ptr Int32 ->                            -- line_number : TBasicType TInt
    Ptr Int32 ->                            -- char_number : TBasicType TInt
    IO ()

-- | Retrieves the current line number and the number of the character on
-- that line. Intended for use in error messages; there are no strict
-- semantics for what constitutes the \"current\" line number other than
-- \"the best number we could come up with for error messages.\"
buildableParseContextGetPosition ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BuildableParseContext
    -- ^ /@context@/: a @GtkBuildableParseContext@
    -> m ((Int32, Int32))
buildableParseContextGetPosition :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BuildableParseContext -> m (Int32, Int32)
buildableParseContextGetPosition BuildableParseContext
context = IO (Int32, Int32) -> m (Int32, Int32)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32) -> m (Int32, Int32))
-> IO (Int32, Int32) -> m (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr BuildableParseContext
context' <- BuildableParseContext -> IO (Ptr BuildableParseContext)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BuildableParseContext
context
    Ptr Int32
lineNumber <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
charNumber <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr BuildableParseContext -> Ptr Int32 -> Ptr Int32 -> IO ()
gtk_buildable_parse_context_get_position Ptr BuildableParseContext
context' Ptr Int32
lineNumber Ptr Int32
charNumber
    Int32
lineNumber' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
lineNumber
    Int32
charNumber' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
charNumber
    BuildableParseContext -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BuildableParseContext
context
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
lineNumber
    Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
charNumber
    (Int32, Int32) -> IO (Int32, Int32)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
lineNumber', Int32
charNumber')

#if defined(ENABLE_OVERLOADING)
data BuildableParseContextGetPositionMethodInfo
instance (signature ~ (m ((Int32, Int32))), MonadIO m) => O.OverloadedMethod BuildableParseContextGetPositionMethodInfo BuildableParseContext signature where
    overloadedMethod = buildableParseContextGetPosition

instance O.OverloadedMethodInfo BuildableParseContextGetPositionMethodInfo BuildableParseContext where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.BuildableParseContext.buildableParseContextGetPosition",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Structs-BuildableParseContext.html#v:buildableParseContextGetPosition"
        })


#endif

-- method BuildableParseContext::pop
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "BuildableParseContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkBuildableParseContext`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TPtr)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_buildable_parse_context_pop" gtk_buildable_parse_context_pop :: 
    Ptr BuildableParseContext ->            -- context : TInterface (Name {namespace = "Gtk", name = "BuildableParseContext"})
    IO (Ptr ())

-- | Completes the process of a temporary sub-parser redirection.
-- 
-- This function exists to collect the user_data allocated by a
-- matching call to 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextPush'. It must be called
-- in the end_element handler corresponding to the start_element
-- handler during which 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextPush' was called.
-- You must not call this function from the error callback -- the
-- /@userData@/ is provided directly to the callback in that case.
-- 
-- This function is not intended to be directly called by users
-- interested in invoking subparsers. Instead, it is intended to
-- be used by the subparsers themselves to implement a higher-level
-- interface.
buildableParseContextPop ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BuildableParseContext
    -- ^ /@context@/: a @GtkBuildableParseContext@
    -> m (Ptr ())
    -- ^ __Returns:__ the user data passed to 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextPush'
buildableParseContextPop :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BuildableParseContext -> m (Ptr ())
buildableParseContextPop BuildableParseContext
context = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
    Ptr BuildableParseContext
context' <- BuildableParseContext -> IO (Ptr BuildableParseContext)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BuildableParseContext
context
    Ptr ()
result <- Ptr BuildableParseContext -> IO (Ptr ())
gtk_buildable_parse_context_pop Ptr BuildableParseContext
context'
    BuildableParseContext -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BuildableParseContext
context
    Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr ()
result

#if defined(ENABLE_OVERLOADING)
data BuildableParseContextPopMethodInfo
instance (signature ~ (m (Ptr ())), MonadIO m) => O.OverloadedMethod BuildableParseContextPopMethodInfo BuildableParseContext signature where
    overloadedMethod = buildableParseContextPop

instance O.OverloadedMethodInfo BuildableParseContextPopMethodInfo BuildableParseContext where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.BuildableParseContext.buildableParseContextPop",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Structs-BuildableParseContext.html#v:buildableParseContextPop"
        })


#endif

-- method BuildableParseContext::push
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "Gtk" , name = "BuildableParseContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkBuildableParseContext`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parser"
--           , argType =
--               TInterface Name { namespace = "Gtk" , name = "BuildableParser" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a `GtkBuildableParser`"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "user data to pass to `GtkBuildableParser` functions"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_buildable_parse_context_push" gtk_buildable_parse_context_push :: 
    Ptr BuildableParseContext ->            -- context : TInterface (Name {namespace = "Gtk", name = "BuildableParseContext"})
    Ptr Gtk.BuildableParser.BuildableParser -> -- parser : TInterface (Name {namespace = "Gtk", name = "BuildableParser"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Temporarily redirects markup data to a sub-parser.
-- 
-- This function may only be called from the start_element handler of
-- a @GtkBuildableParser@. It must be matched with a corresponding call to
-- 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextPop' in the matching end_element handler
-- (except in the case that the parser aborts due to an error).
-- 
-- All tags, text and other data between the matching tags is
-- redirected to the subparser given by /@parser@/. /@userData@/ is used
-- as the user_data for that parser. /@userData@/ is also passed to the
-- error callback in the event that an error occurs. This includes
-- errors that occur in subparsers of the subparser.
-- 
-- The end tag matching the start tag for which this call was made is
-- handled by the previous parser (which is given its own user_data)
-- which is why 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextPop' is provided to allow \"one
-- last access\" to the /@userData@/ provided to this function. In the
-- case of error, the /@userData@/ provided here is passed directly to
-- the error callback of the subparser and 'GI.Gtk.Structs.BuildableParseContext.buildableParseContextPop'
-- should not be called. In either case, if /@userData@/ was allocated
-- then it ought to be freed from both of these locations.
-- 
-- This function is not intended to be directly called by users
-- interested in invoking subparsers. Instead, it is intended to be
-- used by the subparsers themselves to implement a higher-level
-- interface.
-- 
-- For an example of how to use this, see 'GI.GLib.Structs.MarkupParseContext.markupParseContextPush' which
-- has the same kind of API.
buildableParseContextPush ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    BuildableParseContext
    -- ^ /@context@/: a @GtkBuildableParseContext@
    -> Gtk.BuildableParser.BuildableParser
    -- ^ /@parser@/: a @GtkBuildableParser@
    -> Ptr ()
    -- ^ /@userData@/: user data to pass to @GtkBuildableParser@ functions
    -> m ()
buildableParseContextPush :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
BuildableParseContext -> BuildableParser -> Ptr () -> m ()
buildableParseContextPush BuildableParseContext
context BuildableParser
parser Ptr ()
userData = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr BuildableParseContext
context' <- BuildableParseContext -> IO (Ptr BuildableParseContext)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BuildableParseContext
context
    Ptr BuildableParser
parser' <- BuildableParser -> IO (Ptr BuildableParser)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr BuildableParser
parser
    Ptr BuildableParseContext -> Ptr BuildableParser -> Ptr () -> IO ()
gtk_buildable_parse_context_push Ptr BuildableParseContext
context' Ptr BuildableParser
parser' Ptr ()
userData
    BuildableParseContext -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BuildableParseContext
context
    BuildableParser -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr BuildableParser
parser
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data BuildableParseContextPushMethodInfo
instance (signature ~ (Gtk.BuildableParser.BuildableParser -> Ptr () -> m ()), MonadIO m) => O.OverloadedMethod BuildableParseContextPushMethodInfo BuildableParseContext signature where
    overloadedMethod = buildableParseContextPush

instance O.OverloadedMethodInfo BuildableParseContextPushMethodInfo BuildableParseContext where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gtk.Structs.BuildableParseContext.buildableParseContextPush",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtk-4.0.8/docs/GI-Gtk-Structs-BuildableParseContext.html#v:buildableParseContextPush"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveBuildableParseContextMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveBuildableParseContextMethod "pop" o = BuildableParseContextPopMethodInfo
    ResolveBuildableParseContextMethod "push" o = BuildableParseContextPushMethodInfo
    ResolveBuildableParseContextMethod "getElement" o = BuildableParseContextGetElementMethodInfo
    ResolveBuildableParseContextMethod "getElementStack" o = BuildableParseContextGetElementStackMethodInfo
    ResolveBuildableParseContextMethod "getPosition" o = BuildableParseContextGetPositionMethodInfo
    ResolveBuildableParseContextMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif