{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Simple typing wrapper around t'GI.Gst.Structs.Meta.Meta'
-- 
-- /Since: 1.20/

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

module GI.Gst.Structs.CustomMeta
    ( 

-- * Exported types
    CustomMeta(..)                          ,
    newZeroCustomMeta                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveCustomMetaMethod                 ,
#endif

-- ** getStructure #method:getStructure#

#if defined(ENABLE_OVERLOADING)
    CustomMetaGetStructureMethodInfo        ,
#endif
    customMetaGetStructure                  ,


-- ** hasName #method:hasName#

#if defined(ENABLE_OVERLOADING)
    CustomMetaHasNameMethodInfo             ,
#endif
    customMetaHasName                       ,




 -- * Properties


-- ** meta #attr:meta#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    customMeta_meta                         ,
#endif
    getCustomMetaMeta                       ,




    ) 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.Meta as Gst.Meta
import {-# SOURCE #-} qualified GI.Gst.Structs.Structure as Gst.Structure

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

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

instance BoxedPtr CustomMeta where
    boxedPtrCopy :: CustomMeta -> IO CustomMeta
boxedPtrCopy = \CustomMeta
p -> CustomMeta -> (Ptr CustomMeta -> IO CustomMeta) -> IO CustomMeta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr CustomMeta
p (Int -> Ptr CustomMeta -> IO (Ptr CustomMeta)
forall a. (HasCallStack, CallocPtr a) => Int -> Ptr a -> IO (Ptr a)
copyBytes Int
16 (Ptr CustomMeta -> IO (Ptr CustomMeta))
-> (Ptr CustomMeta -> IO CustomMeta)
-> Ptr CustomMeta
-> IO CustomMeta
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr CustomMeta -> CustomMeta)
-> Ptr CustomMeta -> IO CustomMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.wrapPtr ManagedPtr CustomMeta -> CustomMeta
CustomMeta)
    boxedPtrFree :: CustomMeta -> IO ()
boxedPtrFree = \CustomMeta
x -> CustomMeta -> (Ptr CustomMeta -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
SP.withManagedPtr CustomMeta
x Ptr CustomMeta -> IO ()
forall a. Ptr a -> IO ()
SP.freeMem
instance CallocPtr CustomMeta where
    boxedPtrCalloc :: IO (Ptr CustomMeta)
boxedPtrCalloc = Int -> IO (Ptr CustomMeta)
forall a. Int -> IO (Ptr a)
callocBytes Int
16


-- | Construct a `CustomMeta` struct initialized to zero.
newZeroCustomMeta :: MonadIO m => m CustomMeta
newZeroCustomMeta :: forall (m :: * -> *). MonadIO m => m CustomMeta
newZeroCustomMeta = IO CustomMeta -> m CustomMeta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CustomMeta -> m CustomMeta) -> IO CustomMeta -> m CustomMeta
forall a b. (a -> b) -> a -> b
$ IO (Ptr CustomMeta)
forall a. CallocPtr a => IO (Ptr a)
boxedPtrCalloc IO (Ptr CustomMeta)
-> (Ptr CustomMeta -> IO CustomMeta) -> IO CustomMeta
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr CustomMeta -> CustomMeta)
-> Ptr CustomMeta -> IO CustomMeta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr CustomMeta -> CustomMeta
CustomMeta

instance tag ~ 'AttrSet => Constructible CustomMeta tag where
    new :: forall (m :: * -> *).
MonadIO m =>
(ManagedPtr CustomMeta -> CustomMeta)
-> [AttrOp CustomMeta tag] -> m CustomMeta
new ManagedPtr CustomMeta -> CustomMeta
_ [AttrOp CustomMeta tag]
attrs = do
        CustomMeta
o <- m CustomMeta
forall (m :: * -> *). MonadIO m => m CustomMeta
newZeroCustomMeta
        CustomMeta -> [AttrOp CustomMeta 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set CustomMeta
o [AttrOp CustomMeta tag]
[AttrOp CustomMeta 'AttrSet]
attrs
        CustomMeta -> m CustomMeta
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return CustomMeta
o


-- | Get the value of the “@meta@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' customMeta #meta
-- @
getCustomMetaMeta :: MonadIO m => CustomMeta -> m Gst.Meta.Meta
getCustomMetaMeta :: forall (m :: * -> *). MonadIO m => CustomMeta -> m Meta
getCustomMetaMeta CustomMeta
s = IO Meta -> m Meta
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Meta -> m Meta) -> IO Meta -> m Meta
forall a b. (a -> b) -> a -> b
$ CustomMeta -> (Ptr CustomMeta -> IO Meta) -> IO Meta
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr CustomMeta
s ((Ptr CustomMeta -> IO Meta) -> IO Meta)
-> (Ptr CustomMeta -> IO Meta) -> IO Meta
forall a b. (a -> b) -> a -> b
$ \Ptr CustomMeta
ptr -> do
    let val :: Ptr Meta
val = Ptr CustomMeta
ptr Ptr CustomMeta -> Int -> Ptr Meta
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0 :: (Ptr Gst.Meta.Meta)
    Meta
val' <- ((ManagedPtr Meta -> Meta) -> Ptr Meta -> IO Meta
forall a.
(HasCallStack, BoxedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newPtr ManagedPtr Meta -> Meta
Gst.Meta.Meta) Ptr Meta
val
    Meta -> IO Meta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Meta
val'

#if defined(ENABLE_OVERLOADING)
data CustomMetaMetaFieldInfo
instance AttrInfo CustomMetaMetaFieldInfo where
    type AttrBaseTypeConstraint CustomMetaMetaFieldInfo = (~) CustomMeta
    type AttrAllowedOps CustomMetaMetaFieldInfo = '[ 'AttrGet]
    type AttrSetTypeConstraint CustomMetaMetaFieldInfo = (~) (Ptr Gst.Meta.Meta)
    type AttrTransferTypeConstraint CustomMetaMetaFieldInfo = (~)(Ptr Gst.Meta.Meta)
    type AttrTransferType CustomMetaMetaFieldInfo = (Ptr Gst.Meta.Meta)
    type AttrGetType CustomMetaMetaFieldInfo = Gst.Meta.Meta
    type AttrLabel CustomMetaMetaFieldInfo = "meta"
    type AttrOrigin CustomMetaMetaFieldInfo = CustomMeta
    attrGet = getCustomMetaMeta
    attrSet = undefined
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gst.Structs.CustomMeta.meta"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gst-1.0.26/docs/GI-Gst-Structs-CustomMeta.html#g:attr:meta"
        })

customMeta_meta :: AttrLabelProxy "meta"
customMeta_meta = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CustomMeta
type instance O.AttributeList CustomMeta = CustomMetaAttributeList
type CustomMetaAttributeList = ('[ '("meta", CustomMetaMetaFieldInfo)] :: [(Symbol, *)])
#endif

-- method CustomMeta::get_structure
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CustomMeta" }
--           , 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 = "Gst" , name = "Structure" })
-- throws : False
-- Skip return : False

foreign import ccall "gst_custom_meta_get_structure" gst_custom_meta_get_structure :: 
    Ptr CustomMeta ->                       -- meta : TInterface (Name {namespace = "Gst", name = "CustomMeta"})
    IO (Ptr Gst.Structure.Structure)

-- | Retrieve the t'GI.Gst.Structs.Structure.Structure' backing a custom meta, the structure\'s mutability
-- is conditioned to the writability of the t'GI.Gst.Structs.Buffer.Buffer' /@meta@/ is attached to.
-- 
-- /Since: 1.20/
customMetaGetStructure ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CustomMeta
    -> m Gst.Structure.Structure
    -- ^ __Returns:__ the t'GI.Gst.Structs.Structure.Structure' backing /@meta@/
customMetaGetStructure :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CustomMeta -> m Structure
customMetaGetStructure CustomMeta
meta = 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 CustomMeta
meta' <- CustomMeta -> IO (Ptr CustomMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CustomMeta
meta
    Ptr Structure
result <- Ptr CustomMeta -> IO (Ptr Structure)
gst_custom_meta_get_structure Ptr CustomMeta
meta'
    Text -> Ptr Structure -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"customMetaGetStructure" 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
    CustomMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CustomMeta
meta
    Structure -> IO Structure
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Structure
result'

#if defined(ENABLE_OVERLOADING)
data CustomMetaGetStructureMethodInfo
instance (signature ~ (m Gst.Structure.Structure), MonadIO m) => O.OverloadedMethod CustomMetaGetStructureMethodInfo CustomMeta signature where
    overloadedMethod = customMetaGetStructure

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


#endif

-- method CustomMeta::has_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "meta"
--           , argType =
--               TInterface Name { namespace = "Gst" , name = "CustomMeta" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_custom_meta_has_name" gst_custom_meta_has_name :: 
    Ptr CustomMeta ->                       -- meta : TInterface (Name {namespace = "Gst", name = "CustomMeta"})
    CString ->                              -- name : TBasicType TUTF8
    IO CInt

-- | Checks whether the name of the custom meta is /@name@/
-- 
-- /Since: 1.20/
customMetaHasName ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    CustomMeta
    -> T.Text
    -> m Bool
    -- ^ __Returns:__ Whether /@name@/ is the name of the custom meta
customMetaHasName :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
CustomMeta -> Text -> m Bool
customMetaHasName CustomMeta
meta Text
name = 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 CustomMeta
meta' <- CustomMeta -> IO (Ptr CustomMeta)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CustomMeta
meta
    CString
name' <- Text -> IO CString
textToCString Text
name
    CInt
result <- Ptr CustomMeta -> CString -> IO CInt
gst_custom_meta_has_name Ptr CustomMeta
meta' CString
name'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    CustomMeta -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CustomMeta
meta
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

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


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCustomMetaMethod (t :: Symbol) (o :: *) :: * where
    ResolveCustomMetaMethod "hasName" o = CustomMetaHasNameMethodInfo
    ResolveCustomMetaMethod "getStructure" o = CustomMetaGetStructureMethodInfo
    ResolveCustomMetaMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif