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

Datastructure to initialize 'GI.Gst.Structs.Caps.Caps' from a string description usually
used in conjunction with @/GST_STATIC_CAPS()/@ and 'GI.Gst.Structs.StaticCaps.staticCapsGet' to
instantiate a 'GI.Gst.Structs.Caps.Caps'.
-}

module GI.Gst.Structs.StaticCaps
    ( 

-- * Exported types
    StaticCaps(..)                          ,
    newZeroStaticCaps                       ,
    noStaticCaps                            ,


 -- * Methods
-- ** cleanup #method:cleanup#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    StaticCapsCleanupMethodInfo             ,
#endif
    staticCapsCleanup                       ,


-- ** get #method:get#
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    StaticCapsGetMethodInfo                 ,
#endif
    staticCapsGet                           ,




 -- * Properties
-- ** caps #attr:caps#
    clearStaticCapsCaps                     ,
    getStaticCapsCaps                       ,
    setStaticCapsCaps                       ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    staticCaps_caps                         ,
#endif


-- ** string #attr:string#
    clearStaticCapsString                   ,
    getStaticCapsString                     ,
    setStaticCapsString                     ,
#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
    staticCaps_string                       ,
#endif




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

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

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

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


noStaticCaps :: Maybe StaticCaps
noStaticCaps = Nothing

getStaticCapsCaps :: MonadIO m => StaticCaps -> m (Maybe Gst.Caps.Caps)
getStaticCapsCaps s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 0) :: IO (Ptr Gst.Caps.Caps)
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- (newBoxed Gst.Caps.Caps) val'
        return val''
    return result

setStaticCapsCaps :: MonadIO m => StaticCaps -> Ptr Gst.Caps.Caps -> m ()
setStaticCapsCaps s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (val :: Ptr Gst.Caps.Caps)

clearStaticCapsCaps :: MonadIO m => StaticCaps -> m ()
clearStaticCapsCaps s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 0) (FP.nullPtr :: Ptr Gst.Caps.Caps)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data StaticCapsCapsFieldInfo
instance AttrInfo StaticCapsCapsFieldInfo where
    type AttrAllowedOps StaticCapsCapsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint StaticCapsCapsFieldInfo = (~) (Ptr Gst.Caps.Caps)
    type AttrBaseTypeConstraint StaticCapsCapsFieldInfo = (~) StaticCaps
    type AttrGetType StaticCapsCapsFieldInfo = Maybe Gst.Caps.Caps
    type AttrLabel StaticCapsCapsFieldInfo = "caps"
    type AttrOrigin StaticCapsCapsFieldInfo = StaticCaps
    attrGet _ = getStaticCapsCaps
    attrSet _ = setStaticCapsCaps
    attrConstruct = undefined
    attrClear _ = clearStaticCapsCaps

staticCaps_caps :: AttrLabelProxy "caps"
staticCaps_caps = AttrLabelProxy

#endif


getStaticCapsString :: MonadIO m => StaticCaps -> m (Maybe T.Text)
getStaticCapsString s = liftIO $ withManagedPtr s $ \ptr -> do
    val <- peek (ptr `plusPtr` 8) :: IO CString
    result <- SP.convertIfNonNull val $ \val' -> do
        val'' <- cstringToText val'
        return val''
    return result

setStaticCapsString :: MonadIO m => StaticCaps -> CString -> m ()
setStaticCapsString s val = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (val :: CString)

clearStaticCapsString :: MonadIO m => StaticCaps -> m ()
clearStaticCapsString s = liftIO $ withManagedPtr s $ \ptr -> do
    poke (ptr `plusPtr` 8) (FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data StaticCapsStringFieldInfo
instance AttrInfo StaticCapsStringFieldInfo where
    type AttrAllowedOps StaticCapsStringFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint StaticCapsStringFieldInfo = (~) CString
    type AttrBaseTypeConstraint StaticCapsStringFieldInfo = (~) StaticCaps
    type AttrGetType StaticCapsStringFieldInfo = Maybe T.Text
    type AttrLabel StaticCapsStringFieldInfo = "string"
    type AttrOrigin StaticCapsStringFieldInfo = StaticCaps
    attrGet _ = getStaticCapsString
    attrSet _ = setStaticCapsString
    attrConstruct = undefined
    attrClear _ = clearStaticCapsString

staticCaps_string :: AttrLabelProxy "string"
staticCaps_string = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
instance O.HasAttributeList StaticCaps
type instance O.AttributeList StaticCaps = StaticCapsAttributeList
type StaticCapsAttributeList = ('[ '("caps", StaticCapsCapsFieldInfo), '("string", StaticCapsStringFieldInfo)] :: [(Symbol, *)])
#endif

-- method StaticCaps::cleanup
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "static_caps", argType = TInterface (Name {namespace = "Gst", name = "StaticCaps"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the #GstStaticCaps to clean", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gst_static_caps_cleanup" gst_static_caps_cleanup :: 
    Ptr StaticCaps ->                       -- static_caps : TInterface (Name {namespace = "Gst", name = "StaticCaps"})
    IO ()

{- |
Clean up the cached caps contained in /@staticCaps@/.
-}
staticCapsCleanup ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StaticCaps
    {- ^ /@staticCaps@/: the 'GI.Gst.Structs.StaticCaps.StaticCaps' to clean -}
    -> m ()
staticCapsCleanup staticCaps = liftIO $ do
    staticCaps' <- unsafeManagedPtrGetPtr staticCaps
    gst_static_caps_cleanup staticCaps'
    touchManagedPtr staticCaps
    return ()

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data StaticCapsCleanupMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo StaticCapsCleanupMethodInfo StaticCaps signature where
    overloadedMethod _ = staticCapsCleanup

#endif

-- method StaticCaps::get
-- method type : OrdinaryMethod
-- Args : [Arg {argCName = "static_caps", argType = TInterface (Name {namespace = "Gst", name = "StaticCaps"}), direction = DirectionIn, mayBeNull = False, argDoc = Documentation {rawDocText = Just "the #GstStaticCaps to convert", sinceVersion = Nothing}, argScope = ScopeTypeInvalid, argClosure = -1, argDestroy = -1, argCallerAllocates = False, transfer = TransferNothing}]
-- Lengths : []
-- returnType : Just (TInterface (Name {namespace = "Gst", name = "Caps"}))
-- throws : False
-- Skip return : False

foreign import ccall "gst_static_caps_get" gst_static_caps_get :: 
    Ptr StaticCaps ->                       -- static_caps : TInterface (Name {namespace = "Gst", name = "StaticCaps"})
    IO (Ptr Gst.Caps.Caps)

{- |
Converts a 'GI.Gst.Structs.StaticCaps.StaticCaps' to a 'GI.Gst.Structs.Caps.Caps'.
-}
staticCapsGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    StaticCaps
    {- ^ /@staticCaps@/: the 'GI.Gst.Structs.StaticCaps.StaticCaps' to convert -}
    -> m Gst.Caps.Caps
    {- ^ __Returns:__ a pointer to the 'GI.Gst.Structs.Caps.Caps'. Unref after usage.
    Since the core holds an additional ref to the returned caps,
    use @/gst_caps_make_writable()/@ on the returned caps to modify it. -}
staticCapsGet staticCaps = liftIO $ do
    staticCaps' <- unsafeManagedPtrGetPtr staticCaps
    result <- gst_static_caps_get staticCaps'
    checkUnexpectedReturnNULL "staticCapsGet" result
    result' <- (wrapBoxed Gst.Caps.Caps) result
    touchManagedPtr staticCaps
    return result'

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
data StaticCapsGetMethodInfo
instance (signature ~ (m Gst.Caps.Caps), MonadIO m) => O.MethodInfo StaticCapsGetMethodInfo StaticCaps signature where
    overloadedMethod _ = staticCapsGet

#endif

#if defined(ENABLE_OVERLOADING) && !defined(__HADDOCK_VERSION__)
type family ResolveStaticCapsMethod (t :: Symbol) (o :: *) :: * where
    ResolveStaticCapsMethod "cleanup" o = StaticCapsCleanupMethodInfo
    ResolveStaticCapsMethod "get" o = StaticCapsGetMethodInfo
    ResolveStaticCapsMethod l o = O.MethodResolutionFailed l o

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

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

#endif