{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Gst.Structs.Context.Context' is a container object used to store contexts like a device
-- context, a display server connection and similar concepts that should
-- be shared between multiple elements.
-- 
-- Applications can set a context on a complete pipeline by using
-- 'GI.Gst.Objects.Element.elementSetContext', which will then be propagated to all
-- child elements. Elements can handle these in t'GI.Gst.Structs.ElementClass.ElementClass'::@/set_context/@
-- and merge them with the context information they already have.
-- 
-- When an element needs a context it will do the following actions in this
-- order until one step succeeds:
-- 
-- 1. Check if the element already has a context
-- 2. Query downstream with 'GI.Gst.Enums.QueryTypeContext' for the context
-- 3. Query upstream with 'GI.Gst.Enums.QueryTypeContext' for the context
-- 4. Post a 'GI.Gst.Flags.MessageTypeNeedContext' message on the bus with the required
--    context types and afterwards check if a usable context was set now
-- 5. Create a context by itself and post a 'GI.Gst.Flags.MessageTypeHaveContext' message
--    on the bus.
-- 
-- Bins will catch 'GI.Gst.Flags.MessageTypeNeedContext' messages and will set any previously
-- known context on the element that asks for it if possible. Otherwise the
-- application should provide one if it can.
-- 
-- t'GI.Gst.Structs.Context.Context' can be persistent.
-- A persistent t'GI.Gst.Structs.Context.Context' is kept in elements when they reach
-- 'GI.Gst.Enums.StateNull', non-persistent ones will be removed.
-- Also, a non-persistent context won\'t override a previous persistent
-- context set to an element.
-- 
-- /Since: 1.2/

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

module GI.Gst.Structs.Context
    ( 

-- * Exported types
    Context(..)                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [hasContextType]("GI.Gst.Structs.Context#g:method:hasContextType"), [isPersistent]("GI.Gst.Structs.Context#g:method:isPersistent"), [writableStructure]("GI.Gst.Structs.Context#g:method:writableStructure").
-- 
-- ==== Getters
-- [getContextType]("GI.Gst.Structs.Context#g:method:getContextType"), [getStructure]("GI.Gst.Structs.Context#g:method:getStructure").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveContextMethod                    ,
#endif

-- ** getContextType #method:getContextType#

#if defined(ENABLE_OVERLOADING)
    ContextGetContextTypeMethodInfo         ,
#endif
    contextGetContextType                   ,


-- ** getStructure #method:getStructure#

#if defined(ENABLE_OVERLOADING)
    ContextGetStructureMethodInfo           ,
#endif
    contextGetStructure                     ,


-- ** hasContextType #method:hasContextType#

#if defined(ENABLE_OVERLOADING)
    ContextHasContextTypeMethodInfo         ,
#endif
    contextHasContextType                   ,


-- ** isPersistent #method:isPersistent#

#if defined(ENABLE_OVERLOADING)
    ContextIsPersistentMethodInfo           ,
#endif
    contextIsPersistent                     ,


-- ** new #method:new#

    contextNew                              ,


-- ** writableStructure #method:writableStructure#

#if defined(ENABLE_OVERLOADING)
    ContextWritableStructureMethodInfo      ,
#endif
    contextWritableStructure                ,




    ) 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.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.Gst.Structs.Structure as Gst.Structure

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

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

foreign import ccall "gst_context_get_type" c_gst_context_get_type :: 
    IO GType

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

instance B.Types.TypedObject Context where
    glibType :: IO GType
glibType = IO GType
c_gst_context_get_type

instance B.Types.GBoxed Context

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


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

-- method Context::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "context_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Context type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "persistent"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Persistent context" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Context" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_context_new" gst_context_new :: 
    CString ->                              -- context_type : TBasicType TUTF8
    CInt ->                                 -- persistent : TBasicType TBoolean
    IO (Ptr Context)

-- | Creates a new context.
-- 
-- /Since: 1.2/
contextNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@contextType@/: Context type
    -> Bool
    -- ^ /@persistent@/: Persistent context
    -> m Context
    -- ^ __Returns:__ The new context.
contextNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Bool -> m Context
contextNew Text
contextType Bool
persistent = IO Context -> m Context
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Context -> m Context) -> IO Context -> m Context
forall a b. (a -> b) -> a -> b
$ do
    CString
contextType' <- Text -> IO CString
textToCString Text
contextType
    let persistent' :: CInt
persistent' = (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
persistent
    Ptr Context
result <- CString -> CInt -> IO (Ptr Context)
gst_context_new CString
contextType' CInt
persistent'
    Text -> Ptr Context -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contextNew" Ptr Context
result
    Context
result' <- ((ManagedPtr Context -> Context) -> Ptr Context -> IO Context
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Context -> Context
Context) Ptr Context
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contextType'
    Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Context
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Context::get_context_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstContext." , 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 "gst_context_get_context_type" gst_context_get_context_type :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO CString

-- | Gets the type of /@context@/.
-- 
-- /Since: 1.2/
contextGetContextType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Context
    -- ^ /@context@/: The t'GI.Gst.Structs.Context.Context'.
    -> m T.Text
    -- ^ __Returns:__ The type of the context.
contextGetContextType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> m Text
contextGetContextType Context
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 Context
context' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
context
    CString
result <- Ptr Context -> IO CString
gst_context_get_context_type Ptr Context
context'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contextGetContextType" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
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 ContextGetContextTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.OverloadedMethod ContextGetContextTypeMethodInfo Context signature where
    overloadedMethod = contextGetContextType

instance O.OverloadedMethodInfo ContextGetContextTypeMethodInfo Context where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Context.contextGetContextType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Context.html#v:contextGetContextType"
        })


#endif

-- method Context::get_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstContext." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_context_get_structure" gst_context_get_structure :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO (Ptr Gst.Structure.Structure)

-- | Accesses the structure of the context.
-- 
-- /Since: 1.2/
contextGetStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Context
    -- ^ /@context@/: The t'GI.Gst.Structs.Context.Context'.
    -> m Gst.Structure.Structure
    -- ^ __Returns:__ The structure of the context. The structure is
    -- still owned by the context, which means that you should not modify it,
    -- free it and that the pointer becomes invalid when you free the context.
contextGetStructure :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> m Structure
contextGetStructure Context
context = IO Structure -> m Structure
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
context
    Ptr Structure
result <- Ptr Context -> IO (Ptr Structure)
gst_context_get_structure Ptr Context
context'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contextGetStructure" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
context
    Structure -> IO Structure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data ContextGetStructureMethodInfo
instance (signature ~ (m Gst.Structure.Structure), MonadIO m) => O.OverloadedMethod ContextGetStructureMethodInfo Context signature where
    overloadedMethod = contextGetStructure

instance O.OverloadedMethodInfo ContextGetStructureMethodInfo Context where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Context.contextGetStructure",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Context.html#v:contextGetStructure"
        })


#endif

-- method Context::has_context_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstContext." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "context_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Context type to check."
--                 , 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 "gst_context_has_context_type" gst_context_has_context_type :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    CString ->                              -- context_type : TBasicType TUTF8
    IO CInt

-- | Checks if /@context@/ has /@contextType@/.
-- 
-- /Since: 1.2/
contextHasContextType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Context
    -- ^ /@context@/: The t'GI.Gst.Structs.Context.Context'.
    -> T.Text
    -- ^ /@contextType@/: Context type to check.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@context@/ has /@contextType@/.
contextHasContextType :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> Text -> m Bool
contextHasContextType Context
context Text
contextType = IO Bool -> m Bool
forall a. IO a -> m a
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 Context
context' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
context
    CString
contextType' <- Text -> IO CString
textToCString Text
contextType
    CInt
result <- Ptr Context -> CString -> IO CInt
gst_context_has_context_type Ptr Context
context' CString
contextType'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contextType'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ContextHasContextTypeMethodInfo
instance (signature ~ (T.Text -> m Bool), MonadIO m) => O.OverloadedMethod ContextHasContextTypeMethodInfo Context signature where
    overloadedMethod = contextHasContextType

instance O.OverloadedMethodInfo ContextHasContextTypeMethodInfo Context where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Context.contextHasContextType",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Context.html#v:contextHasContextType"
        })


#endif

-- method Context::is_persistent
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstContext." , 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 "gst_context_is_persistent" gst_context_is_persistent :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO CInt

-- | Checks if /@context@/ is persistent.
-- 
-- /Since: 1.2/
contextIsPersistent ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Context
    -- ^ /@context@/: The t'GI.Gst.Structs.Context.Context'.
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the context is persistent.
contextIsPersistent :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> m Bool
contextIsPersistent Context
context = IO Bool -> m Bool
forall a. IO a -> m a
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 Context
context' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
context
    CInt
result <- Ptr Context -> IO CInt
gst_context_is_persistent Ptr Context
context'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
context
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data ContextIsPersistentMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.OverloadedMethod ContextIsPersistentMethodInfo Context signature where
    overloadedMethod = contextIsPersistent

instance O.OverloadedMethodInfo ContextIsPersistentMethodInfo Context where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Context.contextIsPersistent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Context.html#v:contextIsPersistent"
        })


#endif

-- method Context::writable_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "Context" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #GstContext." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_context_writable_structure" gst_context_writable_structure :: 
    Ptr Context ->                          -- context : TInterface (Name {namespace = "Gst", name = "Context"})
    IO (Ptr Gst.Structure.Structure)

-- | Gets a writable version of the structure.
-- 
-- /Since: 1.2/
contextWritableStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Context
    -- ^ /@context@/: The t'GI.Gst.Structs.Context.Context'.
    -> m Gst.Structure.Structure
    -- ^ __Returns:__ The structure of the context. The structure is still
    -- owned by the context, which means that you should not free it and
    -- that the pointer becomes invalid when you free the context.
    -- This function checks if /@context@/ is writable.
contextWritableStructure :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Context -> m Structure
contextWritableStructure Context
context = IO Structure -> m Structure
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Structure -> m Structure) -> IO Structure -> m Structure
forall a b. (a -> b) -> a -> b
$ do
    Ptr Context
context' <- Context -> IO (Ptr Context)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Context
context
    Ptr Structure
result <- Ptr Context -> IO (Ptr Structure)
gst_context_writable_structure Ptr Context
context'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"contextWritableStructure" Ptr Structure
result
    Structure
result' <- ((ManagedPtr Structure -> Structure)
-> Ptr Structure -> IO Structure
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Structure -> Structure
Gst.Structure.Structure) Ptr Structure
result
    Context -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Context
context
    Structure -> IO Structure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data ContextWritableStructureMethodInfo
instance (signature ~ (m Gst.Structure.Structure), MonadIO m) => O.OverloadedMethod ContextWritableStructureMethodInfo Context signature where
    overloadedMethod = contextWritableStructure

instance O.OverloadedMethodInfo ContextWritableStructureMethodInfo Context where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.Context.contextWritableStructure",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-Context.html#v:contextWritableStructure"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveContextMethod (t :: Symbol) (o :: *) :: * where
    ResolveContextMethod "hasContextType" o = ContextHasContextTypeMethodInfo
    ResolveContextMethod "isPersistent" o = ContextIsPersistentMethodInfo
    ResolveContextMethod "writableStructure" o = ContextWritableStructureMethodInfo
    ResolveContextMethod "getContextType" o = ContextGetContextTypeMethodInfo
    ResolveContextMethod "getStructure" o = ContextGetStructureMethodInfo
    ResolveContextMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif