{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Extra data passed to a \"gst-copy\" transform t'GI.Gst.Callbacks.MetaTransformFunction'.

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

module GI.Gst.Structs.MetaTransformCopy
    ( 

-- * Exported types
    MetaTransformCopy(..)                   ,
    newZeroMetaTransformCopy                ,
    noMetaTransformCopy                     ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveMetaTransformCopyMethod          ,
#endif




 -- * Properties
-- ** offset #attr:offset#
-- | the offset to copy, 0 if /@region@/ is 'P.False', otherwise > 0

    getMetaTransformCopyOffset              ,
#if defined(ENABLE_OVERLOADING)
    metaTransformCopy_offset                ,
#endif
    setMetaTransformCopyOffset              ,


-- ** region #attr:region#
-- | 'P.True' if only region is copied

    getMetaTransformCopyRegion              ,
#if defined(ENABLE_OVERLOADING)
    metaTransformCopy_region                ,
#endif
    setMetaTransformCopyRegion              ,


-- ** size #attr:size#
-- | the size to copy, -1 or the buffer size when /@region@/ is 'P.False'

    getMetaTransformCopySize                ,
#if defined(ENABLE_OVERLOADING)
    metaTransformCopy_size                  ,
#endif
    setMetaTransformCopySize                ,




    ) 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.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
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 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


-- | Memory-managed wrapper type.
newtype MetaTransformCopy = MetaTransformCopy (ManagedPtr MetaTransformCopy)
    deriving (MetaTransformCopy -> MetaTransformCopy -> Bool
(MetaTransformCopy -> MetaTransformCopy -> Bool)
-> (MetaTransformCopy -> MetaTransformCopy -> Bool)
-> Eq MetaTransformCopy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaTransformCopy -> MetaTransformCopy -> Bool
$c/= :: MetaTransformCopy -> MetaTransformCopy -> Bool
== :: MetaTransformCopy -> MetaTransformCopy -> Bool
$c== :: MetaTransformCopy -> MetaTransformCopy -> Bool
Eq)
instance WrappedPtr MetaTransformCopy where
    wrappedPtrCalloc :: IO (Ptr MetaTransformCopy)
wrappedPtrCalloc = Int -> IO (Ptr MetaTransformCopy)
forall a. Int -> IO (Ptr a)
callocBytes 24
    wrappedPtrCopy :: MetaTransformCopy -> IO MetaTransformCopy
wrappedPtrCopy = \p :: MetaTransformCopy
p -> MetaTransformCopy
-> (Ptr MetaTransformCopy -> IO MetaTransformCopy)
-> IO MetaTransformCopy
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MetaTransformCopy
p (Int -> Ptr MetaTransformCopy -> IO (Ptr MetaTransformCopy)
forall a. WrappedPtr a => Int -> Ptr a -> IO (Ptr a)
copyBytes 24 (Ptr MetaTransformCopy -> IO (Ptr MetaTransformCopy))
-> (Ptr MetaTransformCopy -> IO MetaTransformCopy)
-> Ptr MetaTransformCopy
-> IO MetaTransformCopy
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (ManagedPtr MetaTransformCopy -> MetaTransformCopy)
-> Ptr MetaTransformCopy -> IO MetaTransformCopy
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr MetaTransformCopy -> MetaTransformCopy
MetaTransformCopy)
    wrappedPtrFree :: Maybe (GDestroyNotify MetaTransformCopy)
wrappedPtrFree = GDestroyNotify MetaTransformCopy
-> Maybe (GDestroyNotify MetaTransformCopy)
forall a. a -> Maybe a
Just GDestroyNotify MetaTransformCopy
forall a. FunPtr (Ptr a -> IO ())
ptr_to_g_free

-- | Construct a `MetaTransformCopy` struct initialized to zero.
newZeroMetaTransformCopy :: MonadIO m => m MetaTransformCopy
newZeroMetaTransformCopy :: m MetaTransformCopy
newZeroMetaTransformCopy = IO MetaTransformCopy -> m MetaTransformCopy
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MetaTransformCopy -> m MetaTransformCopy)
-> IO MetaTransformCopy -> m MetaTransformCopy
forall a b. (a -> b) -> a -> b
$ IO (Ptr MetaTransformCopy)
forall a. WrappedPtr a => IO (Ptr a)
wrappedPtrCalloc IO (Ptr MetaTransformCopy)
-> (Ptr MetaTransformCopy -> IO MetaTransformCopy)
-> IO MetaTransformCopy
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr MetaTransformCopy -> MetaTransformCopy)
-> Ptr MetaTransformCopy -> IO MetaTransformCopy
forall a.
(HasCallStack, WrappedPtr a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapPtr ManagedPtr MetaTransformCopy -> MetaTransformCopy
MetaTransformCopy

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


-- | A convenience alias for `Nothing` :: `Maybe` `MetaTransformCopy`.
noMetaTransformCopy :: Maybe MetaTransformCopy
noMetaTransformCopy :: Maybe MetaTransformCopy
noMetaTransformCopy = Maybe MetaTransformCopy
forall a. Maybe a
Nothing

-- | Get the value of the “@region@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' metaTransformCopy #region
-- @
getMetaTransformCopyRegion :: MonadIO m => MetaTransformCopy -> m Bool
getMetaTransformCopyRegion :: MetaTransformCopy -> m Bool
getMetaTransformCopyRegion s :: MetaTransformCopy
s = IO Bool -> m Bool
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
$ MetaTransformCopy -> (Ptr MetaTransformCopy -> IO Bool) -> IO Bool
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MetaTransformCopy
s ((Ptr MetaTransformCopy -> IO Bool) -> IO Bool)
-> (Ptr MetaTransformCopy -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MetaTransformCopy
ptr -> do
    CInt
val <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr MetaTransformCopy
ptr Ptr MetaTransformCopy -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO CInt
    let val' :: Bool
val' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
val
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
val'

-- | Set the value of the “@region@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' metaTransformCopy [ #region 'Data.GI.Base.Attributes.:=' value ]
-- @
setMetaTransformCopyRegion :: MonadIO m => MetaTransformCopy -> Bool -> m ()
setMetaTransformCopyRegion :: MetaTransformCopy -> Bool -> m ()
setMetaTransformCopyRegion s :: MetaTransformCopy
s val :: Bool
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MetaTransformCopy -> (Ptr MetaTransformCopy -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MetaTransformCopy
s ((Ptr MetaTransformCopy -> IO ()) -> IO ())
-> (Ptr MetaTransformCopy -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MetaTransformCopy
ptr -> do
    let val' :: CInt
val' = (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
val
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MetaTransformCopy
ptr Ptr MetaTransformCopy -> Int -> Ptr CInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) (CInt
val' :: CInt)

#if defined(ENABLE_OVERLOADING)
data MetaTransformCopyRegionFieldInfo
instance AttrInfo MetaTransformCopyRegionFieldInfo where
    type AttrBaseTypeConstraint MetaTransformCopyRegionFieldInfo = (~) MetaTransformCopy
    type AttrAllowedOps MetaTransformCopyRegionFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MetaTransformCopyRegionFieldInfo = (~) Bool
    type AttrTransferTypeConstraint MetaTransformCopyRegionFieldInfo = (~)Bool
    type AttrTransferType MetaTransformCopyRegionFieldInfo = Bool
    type AttrGetType MetaTransformCopyRegionFieldInfo = Bool
    type AttrLabel MetaTransformCopyRegionFieldInfo = "region"
    type AttrOrigin MetaTransformCopyRegionFieldInfo = MetaTransformCopy
    attrGet = getMetaTransformCopyRegion
    attrSet = setMetaTransformCopyRegion
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

metaTransformCopy_region :: AttrLabelProxy "region"
metaTransformCopy_region = AttrLabelProxy

#endif


-- | Get the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' metaTransformCopy #offset
-- @
getMetaTransformCopyOffset :: MonadIO m => MetaTransformCopy -> m Word64
getMetaTransformCopyOffset :: MetaTransformCopy -> m Word64
getMetaTransformCopyOffset s :: MetaTransformCopy
s = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ MetaTransformCopy
-> (Ptr MetaTransformCopy -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MetaTransformCopy
s ((Ptr MetaTransformCopy -> IO Word64) -> IO Word64)
-> (Ptr MetaTransformCopy -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MetaTransformCopy
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr MetaTransformCopy
ptr Ptr MetaTransformCopy -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

-- | Set the value of the “@offset@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' metaTransformCopy [ #offset 'Data.GI.Base.Attributes.:=' value ]
-- @
setMetaTransformCopyOffset :: MonadIO m => MetaTransformCopy -> Word64 -> m ()
setMetaTransformCopyOffset :: MetaTransformCopy -> Word64 -> m ()
setMetaTransformCopyOffset s :: MetaTransformCopy
s val :: Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MetaTransformCopy -> (Ptr MetaTransformCopy -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MetaTransformCopy
s ((Ptr MetaTransformCopy -> IO ()) -> IO ())
-> (Ptr MetaTransformCopy -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MetaTransformCopy
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MetaTransformCopy
ptr Ptr MetaTransformCopy -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data MetaTransformCopyOffsetFieldInfo
instance AttrInfo MetaTransformCopyOffsetFieldInfo where
    type AttrBaseTypeConstraint MetaTransformCopyOffsetFieldInfo = (~) MetaTransformCopy
    type AttrAllowedOps MetaTransformCopyOffsetFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MetaTransformCopyOffsetFieldInfo = (~) Word64
    type AttrTransferTypeConstraint MetaTransformCopyOffsetFieldInfo = (~)Word64
    type AttrTransferType MetaTransformCopyOffsetFieldInfo = Word64
    type AttrGetType MetaTransformCopyOffsetFieldInfo = Word64
    type AttrLabel MetaTransformCopyOffsetFieldInfo = "offset"
    type AttrOrigin MetaTransformCopyOffsetFieldInfo = MetaTransformCopy
    attrGet = getMetaTransformCopyOffset
    attrSet = setMetaTransformCopyOffset
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

metaTransformCopy_offset :: AttrLabelProxy "offset"
metaTransformCopy_offset = AttrLabelProxy

#endif


-- | Get the value of the “@size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' metaTransformCopy #size
-- @
getMetaTransformCopySize :: MonadIO m => MetaTransformCopy -> m Word64
getMetaTransformCopySize :: MetaTransformCopy -> m Word64
getMetaTransformCopySize s :: MetaTransformCopy
s = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ MetaTransformCopy
-> (Ptr MetaTransformCopy -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MetaTransformCopy
s ((Ptr MetaTransformCopy -> IO Word64) -> IO Word64)
-> (Ptr MetaTransformCopy -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MetaTransformCopy
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr MetaTransformCopy
ptr Ptr MetaTransformCopy -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

-- | Set the value of the “@size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' metaTransformCopy [ #size 'Data.GI.Base.Attributes.:=' value ]
-- @
setMetaTransformCopySize :: MonadIO m => MetaTransformCopy -> Word64 -> m ()
setMetaTransformCopySize :: MetaTransformCopy -> Word64 -> m ()
setMetaTransformCopySize s :: MetaTransformCopy
s val :: Word64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MetaTransformCopy -> (Ptr MetaTransformCopy -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MetaTransformCopy
s ((Ptr MetaTransformCopy -> IO ()) -> IO ())
-> (Ptr MetaTransformCopy -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MetaTransformCopy
ptr -> do
    Ptr Word64 -> Word64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MetaTransformCopy
ptr Ptr MetaTransformCopy -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 16) (Word64
val :: Word64)

#if defined(ENABLE_OVERLOADING)
data MetaTransformCopySizeFieldInfo
instance AttrInfo MetaTransformCopySizeFieldInfo where
    type AttrBaseTypeConstraint MetaTransformCopySizeFieldInfo = (~) MetaTransformCopy
    type AttrAllowedOps MetaTransformCopySizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MetaTransformCopySizeFieldInfo = (~) Word64
    type AttrTransferTypeConstraint MetaTransformCopySizeFieldInfo = (~)Word64
    type AttrTransferType MetaTransformCopySizeFieldInfo = Word64
    type AttrGetType MetaTransformCopySizeFieldInfo = Word64
    type AttrLabel MetaTransformCopySizeFieldInfo = "size"
    type AttrOrigin MetaTransformCopySizeFieldInfo = MetaTransformCopy
    attrGet = getMetaTransformCopySize
    attrSet = setMetaTransformCopySize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

metaTransformCopy_size :: AttrLabelProxy "size"
metaTransformCopy_size = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MetaTransformCopy
type instance O.AttributeList MetaTransformCopy = MetaTransformCopyAttributeList
type MetaTransformCopyAttributeList = ('[ '("region", MetaTransformCopyRegionFieldInfo), '("offset", MetaTransformCopyOffsetFieldInfo), '("size", MetaTransformCopySizeFieldInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMetaTransformCopyMethod (t :: Symbol) (o :: *) :: * where
    ResolveMetaTransformCopyMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMetaTransformCopyMethod t MetaTransformCopy, O.MethodInfo info MetaTransformCopy p) => OL.IsLabel t (MetaTransformCopy -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif