{- |
Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
License    : LGPL-2.1
Maintainer : Iñaki García Etxebarria (garetxe@gmail.com)

The 'GI.Gst.Structs.Meta.Meta' structure should be included as the first member of a 'GI.Gst.Structs.Buffer.Buffer'
metadata structure. The structure defines the API of the metadata and should
be accessible to all elements using the metadata.

A metadata API is registered with 'GI.Gst.Functions.metaApiTypeRegister' which takes a
name for the metadata API and some tags associated with the metadata.
With 'GI.Gst.Functions.metaApiTypeHasTag' one can check if a certain metadata API
contains a given tag.

Multiple implementations of a metadata API can be registered.
To implement a metadata API, 'GI.Gst.Functions.metaRegister' should be used. This
function takes all parameters needed to create, free and transform metadata
along with the size of the metadata. The function returns a 'GI.Gst.Structs.MetaInfo.MetaInfo'
structure that contains the information for the implementation of the API.

A specific implementation can be retrieved by name with 'GI.Gst.Functions.metaGetInfo'.

See 'GI.Gst.Structs.Buffer.Buffer' for how the metadata can be added, retrieved and removed from
buffers.
-}

module GI.Gst.Structs.Meta
    ( 

-- * Exported types
    Meta(..)                                ,
    newZeroMeta                             ,
    noMeta                                  ,


 -- * Methods
-- ** apiTypeGetTags #method:apiTypeGetTags#
    metaApiTypeGetTags                      ,


-- ** apiTypeHasTag #method:apiTypeHasTag#
    metaApiTypeHasTag                       ,


-- ** apiTypeRegister #method:apiTypeRegister#
    metaApiTypeRegister                     ,


-- ** getInfo #method:getInfo#
    metaGetInfo                             ,


-- ** register #method:register#
    metaRegister                            ,




 -- * Properties
-- ** flags #attr:flags#
    getMetaFlags                            ,
    meta_flags                              ,
    setMetaFlags                            ,


-- ** info #attr:info#
    clearMetaInfo                           ,
    getMetaInfo                             ,
    meta_info                               ,
    setMetaInfo                             ,




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
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 GI.Gst.Callbacks as Gst.Callbacks
import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Structs.MetaInfo as Gst.MetaInfo

newtype Meta = Meta (ManagedPtr Meta)
instance WrappedPtr Meta where
    wrappedPtrCalloc = callocBytes 16
    wrappedPtrCopy = \p -> withManagedPtr p (copyBytes 16 >=> wrapPtr Meta)
    wrappedPtrFree = Just ptr_to_g_free

-- | Construct a `Meta` struct initialized to zero.
newZeroMeta :: MonadIO m => m Meta
newZeroMeta = liftIO $ wrappedPtrCalloc >>= wrapPtr Meta

instance tag ~ 'AttrSet => Constructible Meta tag where
    new _ attrs = do
        o <- newZeroMeta
        GI.Attributes.set o attrs
        return o


noMeta :: Maybe Meta
noMeta = Nothing

getMetaFlags :: MonadIO m => Meta -> m [Gst.Flags.MetaFlags]
getMetaFlags s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO CUInt
    let val' = wordToGFlags val
    return val'

setMetaFlags :: MonadIO m => Meta -> [Gst.Flags.MetaFlags] -> m ()
setMetaFlags s val = liftIO $ withManagedPtr s $ \ptr -> do
    let val' = gflagsToWord val
    poke (ptr `plusPtr` 0) (val' :: CUInt)

data MetaFlagsFieldInfo
instance AttrInfo MetaFlagsFieldInfo where
    type AttrAllowedOps MetaFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MetaFlagsFieldInfo = (~) [Gst.Flags.MetaFlags]
    type AttrBaseTypeConstraint MetaFlagsFieldInfo = (~) Meta
    type AttrGetType MetaFlagsFieldInfo = [Gst.Flags.MetaFlags]
    type AttrLabel MetaFlagsFieldInfo = "flags"
    type AttrOrigin MetaFlagsFieldInfo = Meta
    attrGet _ = getMetaFlags
    attrSet _ = setMetaFlags
    attrConstruct = undefined
    attrClear _ = undefined

meta_flags :: AttrLabelProxy "flags"
meta_flags = AttrLabelProxy


getMetaInfo :: MonadIO m => Meta -> m (Maybe Gst.MetaInfo.MetaInfo)
getMetaInfo s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO (Ptr Gst.MetaInfo.MetaInfo)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newPtr Gst.MetaInfo.MetaInfo) val'
        return val''
    return result

setMetaInfo :: MonadIO m => Meta -> Ptr Gst.MetaInfo.MetaInfo -> m ()
setMetaInfo s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: Ptr Gst.MetaInfo.MetaInfo)

clearMetaInfo :: MonadIO m => Meta -> m ()
clearMetaInfo s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: Ptr Gst.MetaInfo.MetaInfo)

data MetaInfoFieldInfo
instance AttrInfo MetaInfoFieldInfo where
    type AttrAllowedOps MetaInfoFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MetaInfoFieldInfo = (~) (Ptr Gst.MetaInfo.MetaInfo)
    type AttrBaseTypeConstraint MetaInfoFieldInfo = (~) Meta
    type AttrGetType MetaInfoFieldInfo = Maybe Gst.MetaInfo.MetaInfo
    type AttrLabel MetaInfoFieldInfo = "info"
    type AttrOrigin MetaInfoFieldInfo = Meta
    attrGet _ = getMetaInfo
    attrSet _ = setMetaInfo
    attrConstruct = undefined
    attrClear _ = clearMetaInfo

meta_info :: AttrLabelProxy "info"
meta_info = AttrLabelProxy



instance O.HasAttributeList Meta
type instance O.AttributeList Meta = MetaAttributeList
type MetaAttributeList = ('[ '("flags", MetaFlagsFieldInfo), '("info", MetaInfoFieldInfo)] :: [(Symbol, *)])

-- method Meta::api_type_get_tags
-- method type : MemberFunction
-- Args : [Arg {argCName = "api", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an API", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_api_type_get_tags" gst_meta_api_type_get_tags :: 
    CGType ->                               -- api : TBasicType TGType
    IO (Ptr CString)

{- |
/No description available in the introspection data./

@since 1.2
-}
metaApiTypeGetTags ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    {- ^ /@api@/: an API -}
    -> m [T.Text]
    {- ^ __Returns:__ an array of tags as strings. -}
metaApiTypeGetTags api = liftIO $ do
    let api' = gtypeToCGType api
    result <- gst_meta_api_type_get_tags api'
    checkUnexpectedReturnNULL "metaApiTypeGetTags" result
    result' <- unpackZeroTerminatedUTF8CArray result
    return result'

-- method Meta::api_type_has_tag
-- method type : MemberFunction
-- Args : [Arg {argCName = "api", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an API", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "tag", argType = TBasicType TUInt32, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the tag 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_meta_api_type_has_tag" gst_meta_api_type_has_tag :: 
    CGType ->                               -- api : TBasicType TGType
    Word32 ->                               -- tag : TBasicType TUInt32
    IO CInt

{- |
Check if /@api@/ was registered with /@tag@/.
-}
metaApiTypeHasTag ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    {- ^ /@api@/: an API -}
    -> Word32
    {- ^ /@tag@/: the tag to check -}
    -> m Bool
    {- ^ __Returns:__ 'True' if /@api@/ was registered with /@tag@/. -}
metaApiTypeHasTag api tag = liftIO $ do
    let api' = gtypeToCGType api
    result <- gst_meta_api_type_has_tag api' tag
    let result' = (/= 0) result
    return result'

-- method Meta::api_type_register
-- method type : MemberFunction
-- Args : [Arg {argCName = "api", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "an API to register", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "tags", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "tags for @api", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TBasicType TGType)
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_api_type_register" gst_meta_api_type_register :: 
    CString ->                              -- api : TBasicType TUTF8
    CString ->                              -- tags : TBasicType TUTF8
    IO CGType

{- |
Register and return a GType for the /@api@/ and associate it with
/@tags@/.
-}
metaApiTypeRegister ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@api@/: an API to register -}
    -> T.Text
    {- ^ /@tags@/: tags for /@api@/ -}
    -> m GType
    {- ^ __Returns:__ a unique GType for /@api@/. -}
metaApiTypeRegister api tags = liftIO $ do
    api' <- textToCString api
    tags' <- textToCString tags
    result <- gst_meta_api_type_register api' tags'
    let result' = GType result
    freeMem api'
    freeMem tags'
    return result'

-- method Meta::get_info
-- method type : MemberFunction
-- Args : [Arg {argCName = "impl", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the name", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "MetaInfo"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_get_info" gst_meta_get_info :: 
    CString ->                              -- impl : TBasicType TUTF8
    IO (Ptr Gst.MetaInfo.MetaInfo)

{- |
Lookup a previously registered meta info structure by its implementation name
/@impl@/.
-}
metaGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    {- ^ /@impl@/: the name -}
    -> m (Maybe Gst.MetaInfo.MetaInfo)
    {- ^ __Returns:__ a 'GI.Gst.Structs.MetaInfo.MetaInfo' with /@impl@/, or
'Nothing' when no such metainfo exists. -}
metaGetInfo impl = liftIO $ do
    impl' <- textToCString impl
    result <- gst_meta_get_info impl'
    maybeResult <- convertIfNonNull result $ \result' -> do
        result'' <- (newPtr Gst.MetaInfo.MetaInfo) result'
        return result''
    freeMem impl'
    return maybeResult

-- method Meta::register
-- method type : MemberFunction
-- Args : [Arg {argCName = "api", argType = TBasicType TGType, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the type of the #GstMeta API", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "impl", argType = TBasicType TUTF8, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the name of the #GstMeta implementation", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "size", argType = TBasicType TUInt64, direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the size of the #GstMeta structure", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "init_func", argType = TInterface (Name {namespace = "Gst", name = "MetaInitFunction"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstMetaInitFunction", sinceVersion = Nothing}, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "free_func", argType = TInterface (Name {namespace = "Gst", name = "MetaFreeFunction"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstMetaFreeFunction", sinceVersion = Nothing}, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing},Arg {argCName = "transform_func", argType = TInterface (Name {namespace = "Gst", name = "MetaTransformFunction"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "a #GstMetaTransformFunction", sinceVersion = Nothing}, argScope = ScopeTypeAsync, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "MetaInfo"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_meta_register" gst_meta_register :: 
    CGType ->                               -- api : TBasicType TGType
    CString ->                              -- impl : TBasicType TUTF8
    Word64 ->                               -- size : TBasicType TUInt64
    FunPtr Gst.Callbacks.C_MetaInitFunction -> -- init_func : TInterface (Name {namespace = "Gst", name = "MetaInitFunction"})
    FunPtr Gst.Callbacks.C_MetaFreeFunction -> -- free_func : TInterface (Name {namespace = "Gst", name = "MetaFreeFunction"})
    FunPtr Gst.Callbacks.C_MetaTransformFunction -> -- transform_func : TInterface (Name {namespace = "Gst", name = "MetaTransformFunction"})
    IO (Ptr Gst.MetaInfo.MetaInfo)

{- |
Register a new 'GI.Gst.Structs.Meta.Meta' implementation.

The same /@info@/ can be retrieved later with 'GI.Gst.Functions.metaGetInfo' by using
/@impl@/ as the key.
-}
metaRegister ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GType
    {- ^ /@api@/: the type of the 'GI.Gst.Structs.Meta.Meta' API -}
    -> T.Text
    {- ^ /@impl@/: the name of the 'GI.Gst.Structs.Meta.Meta' implementation -}
    -> Word64
    {- ^ /@size@/: the size of the 'GI.Gst.Structs.Meta.Meta' structure -}
    -> Gst.Callbacks.MetaInitFunction
    {- ^ /@initFunc@/: a 'GI.Gst.Callbacks.MetaInitFunction' -}
    -> Gst.Callbacks.MetaFreeFunction
    {- ^ /@freeFunc@/: a 'GI.Gst.Callbacks.MetaFreeFunction' -}
    -> Gst.Callbacks.MetaTransformFunction
    {- ^ /@transformFunc@/: a 'GI.Gst.Callbacks.MetaTransformFunction' -}
    -> m Gst.MetaInfo.MetaInfo
    {- ^ __Returns:__ a 'GI.Gst.Structs.MetaInfo.MetaInfo' that can be used to access metadata. -}
metaRegister api impl size initFunc freeFunc transformFunc = liftIO $ do
    let api' = gtypeToCGType api
    impl' <- textToCString impl
    ptrinitFunc <- callocMem :: IO (Ptr (FunPtr Gst.Callbacks.C_MetaInitFunction))
    initFunc' <- Gst.Callbacks.mk_MetaInitFunction (Gst.Callbacks.wrap_MetaInitFunction (Just ptrinitFunc) initFunc)
    poke ptrinitFunc initFunc'
    ptrfreeFunc <- callocMem :: IO (Ptr (FunPtr Gst.Callbacks.C_MetaFreeFunction))
    freeFunc' <- Gst.Callbacks.mk_MetaFreeFunction (Gst.Callbacks.wrap_MetaFreeFunction (Just ptrfreeFunc) freeFunc)
    poke ptrfreeFunc freeFunc'
    ptrtransformFunc <- callocMem :: IO (Ptr (FunPtr Gst.Callbacks.C_MetaTransformFunction))
    transformFunc' <- Gst.Callbacks.mk_MetaTransformFunction (Gst.Callbacks.wrap_MetaTransformFunction (Just ptrtransformFunc) transformFunc)
    poke ptrtransformFunc transformFunc'
    result <- gst_meta_register api' impl' size initFunc' freeFunc' transformFunc'
    checkUnexpectedReturnNULL "metaRegister" result
    result' <- (newPtr Gst.MetaInfo.MetaInfo) result
    freeMem impl'
    return result'

type family ResolveMetaMethod (t :: Symbol) (o :: *) :: * where
    ResolveMetaMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMetaMethod t Meta, O.MethodInfo info Meta p) => O.IsLabelProxy t (Meta -> p) where
    fromLabelProxy _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)

#if MIN_VERSION_base(4,9,0)
instance (info ~ ResolveMetaMethod t Meta, O.MethodInfo info Meta p) => O.IsLabel t (Meta -> p) where
    fromLabel _ = O.overloadedMethod (O.MethodProxy :: O.MethodProxy info)
#endif