{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A plugin should export a variable of this type called plugin_desc. The plugin
-- loader will use the data provided there to initialize the plugin.
-- 
-- The /@licence@/ parameter must be one of: LGPL, GPL, QPL, GPL\/QPL, MPL,
-- BSD, MIT\/X11, Proprietary, unknown.

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

module GI.Gst.Structs.PluginDesc
    ( 

-- * Exported types
    PluginDesc(..)                          ,
    newZeroPluginDesc                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolvePluginDescMethod                 ,
#endif




 -- * Properties
-- ** description #attr:description#
-- | description of plugin

    clearPluginDescDescription              ,
    getPluginDescDescription                ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_description                  ,
#endif
    setPluginDescDescription                ,


-- ** license #attr:license#
-- | effective license of plugin

    clearPluginDescLicense                  ,
    getPluginDescLicense                    ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_license                      ,
#endif
    setPluginDescLicense                    ,


-- ** majorVersion #attr:majorVersion#
-- | the major version number of core that plugin was compiled for

    getPluginDescMajorVersion               ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_majorVersion                 ,
#endif
    setPluginDescMajorVersion               ,


-- ** minorVersion #attr:minorVersion#
-- | the minor version number of core that plugin was compiled for

    getPluginDescMinorVersion               ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_minorVersion                 ,
#endif
    setPluginDescMinorVersion               ,


-- ** name #attr:name#
-- | a unique name of the plugin

    clearPluginDescName                     ,
    getPluginDescName                       ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_name                         ,
#endif
    setPluginDescName                       ,


-- ** origin #attr:origin#
-- | URL to provider of plugin

    clearPluginDescOrigin                   ,
    getPluginDescOrigin                     ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_origin                       ,
#endif
    setPluginDescOrigin                     ,


-- ** package #attr:package#
-- | shipped package plugin belongs to

    clearPluginDescPackage                  ,
    getPluginDescPackage                    ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_package                      ,
#endif
    setPluginDescPackage                    ,


-- ** pluginInit #attr:pluginInit#
-- | pointer to the init function of this plugin.

    clearPluginDescPluginInit               ,
    getPluginDescPluginInit                 ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_pluginInit                   ,
#endif
    setPluginDescPluginInit                 ,


-- ** releaseDatetime #attr:releaseDatetime#
-- | date time string in ISO 8601
--     format (or rather, a subset thereof), or 'P.Nothing'. Allowed are the
--     following formats: \"YYYY-MM-DD\" and \"YYY-MM-DDTHH:MMZ\" (with
--     \'T\' a separator and \'Z\' indicating UTC\/Zulu time). This field
--     should be set via the GST_PACKAGE_RELEASE_DATETIME
--     preprocessor macro.

    clearPluginDescReleaseDatetime          ,
    getPluginDescReleaseDatetime            ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_releaseDatetime              ,
#endif
    setPluginDescReleaseDatetime            ,


-- ** source #attr:source#
-- | source module plugin belongs to

    clearPluginDescSource                   ,
    getPluginDescSource                     ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_source                       ,
#endif
    setPluginDescSource                     ,


-- ** version #attr:version#
-- | version of the plugin

    clearPluginDescVersion                  ,
    getPluginDescVersion                    ,
#if defined(ENABLE_OVERLOADING)
    pluginDesc_version                      ,
#endif
    setPluginDescVersion                    ,




    ) 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.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 Control.Monad.IO.Class as MIO
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 GI.Gst.Callbacks as Gst.Callbacks

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

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

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


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

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


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

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

#if defined(ENABLE_OVERLOADING)
data PluginDescMajorVersionFieldInfo
instance AttrInfo PluginDescMajorVersionFieldInfo where
    type AttrBaseTypeConstraint PluginDescMajorVersionFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescMajorVersionFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PluginDescMajorVersionFieldInfo = (~) Int32
    type AttrTransferTypeConstraint PluginDescMajorVersionFieldInfo = (~)Int32
    type AttrTransferType PluginDescMajorVersionFieldInfo = Int32
    type AttrGetType PluginDescMajorVersionFieldInfo = Int32
    type AttrLabel PluginDescMajorVersionFieldInfo = "major_version"
    type AttrOrigin PluginDescMajorVersionFieldInfo = PluginDesc
    attrGet = getPluginDescMajorVersion
    attrSet = setPluginDescMajorVersion
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

pluginDesc_majorVersion :: AttrLabelProxy "majorVersion"
pluginDesc_majorVersion = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data PluginDescMinorVersionFieldInfo
instance AttrInfo PluginDescMinorVersionFieldInfo where
    type AttrBaseTypeConstraint PluginDescMinorVersionFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescMinorVersionFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PluginDescMinorVersionFieldInfo = (~) Int32
    type AttrTransferTypeConstraint PluginDescMinorVersionFieldInfo = (~)Int32
    type AttrTransferType PluginDescMinorVersionFieldInfo = Int32
    type AttrGetType PluginDescMinorVersionFieldInfo = Int32
    type AttrLabel PluginDescMinorVersionFieldInfo = "minor_version"
    type AttrOrigin PluginDescMinorVersionFieldInfo = PluginDesc
    attrGet = getPluginDescMinorVersion
    attrSet = setPluginDescMinorVersion
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

pluginDesc_minorVersion :: AttrLabelProxy "minorVersion"
pluginDesc_minorVersion = AttrLabelProxy

#endif


-- | Get the value of the “@name@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #name
-- @
getPluginDescName :: MonadIO m => PluginDesc -> m (Maybe T.Text)
getPluginDescName :: PluginDesc -> m (Maybe Text)
getPluginDescName PluginDesc
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@name@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #name
-- @
clearPluginDescName :: MonadIO m => PluginDesc -> m ()
clearPluginDescName :: PluginDesc -> m ()
clearPluginDescName PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PluginDescNameFieldInfo
instance AttrInfo PluginDescNameFieldInfo where
    type AttrBaseTypeConstraint PluginDescNameFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescNameFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescNameFieldInfo = (~) CString
    type AttrTransferTypeConstraint PluginDescNameFieldInfo = (~)CString
    type AttrTransferType PluginDescNameFieldInfo = CString
    type AttrGetType PluginDescNameFieldInfo = Maybe T.Text
    type AttrLabel PluginDescNameFieldInfo = "name"
    type AttrOrigin PluginDescNameFieldInfo = PluginDesc
    attrGet = getPluginDescName
    attrSet = setPluginDescName
    attrConstruct = undefined
    attrClear = clearPluginDescName
    attrTransfer _ v = do
        return v

pluginDesc_name :: AttrLabelProxy "name"
pluginDesc_name = AttrLabelProxy

#endif


-- | Get the value of the “@description@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #description
-- @
getPluginDescDescription :: MonadIO m => PluginDesc -> m (Maybe T.Text)
getPluginDescDescription :: PluginDesc -> m (Maybe Text)
getPluginDescDescription PluginDesc
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@description@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #description
-- @
clearPluginDescDescription :: MonadIO m => PluginDesc -> m ()
clearPluginDescDescription :: PluginDesc -> m ()
clearPluginDescDescription PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PluginDescDescriptionFieldInfo
instance AttrInfo PluginDescDescriptionFieldInfo where
    type AttrBaseTypeConstraint PluginDescDescriptionFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescDescriptionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescDescriptionFieldInfo = (~) CString
    type AttrTransferTypeConstraint PluginDescDescriptionFieldInfo = (~)CString
    type AttrTransferType PluginDescDescriptionFieldInfo = CString
    type AttrGetType PluginDescDescriptionFieldInfo = Maybe T.Text
    type AttrLabel PluginDescDescriptionFieldInfo = "description"
    type AttrOrigin PluginDescDescriptionFieldInfo = PluginDesc
    attrGet = getPluginDescDescription
    attrSet = setPluginDescDescription
    attrConstruct = undefined
    attrClear = clearPluginDescDescription
    attrTransfer _ v = do
        return v

pluginDesc_description :: AttrLabelProxy "description"
pluginDesc_description = AttrLabelProxy

#endif


-- | Get the value of the “@plugin_init@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #pluginInit
-- @
getPluginDescPluginInit :: MonadIO m => PluginDesc -> m (Maybe Gst.Callbacks.PluginInitFunc)
getPluginDescPluginInit :: PluginDesc -> m (Maybe PluginInitFunc)
getPluginDescPluginInit PluginDesc
s = IO (Maybe PluginInitFunc) -> m (Maybe PluginInitFunc)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe PluginInitFunc) -> m (Maybe PluginInitFunc))
-> IO (Maybe PluginInitFunc) -> m (Maybe PluginInitFunc)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe PluginInitFunc))
-> IO (Maybe PluginInitFunc)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe PluginInitFunc))
 -> IO (Maybe PluginInitFunc))
-> (Ptr PluginDesc -> IO (Maybe PluginInitFunc))
-> IO (Maybe PluginInitFunc)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    FunPtr C_PluginInitFunc
val <- Ptr (FunPtr C_PluginInitFunc) -> IO (FunPtr C_PluginInitFunc)
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr (FunPtr C_PluginInitFunc)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) :: IO (FunPtr Gst.Callbacks.C_PluginInitFunc)
    Maybe PluginInitFunc
result <- FunPtr C_PluginInitFunc
-> (FunPtr C_PluginInitFunc -> IO PluginInitFunc)
-> IO (Maybe PluginInitFunc)
forall a b. FunPtr a -> (FunPtr a -> IO b) -> IO (Maybe b)
SP.convertFunPtrIfNonNull FunPtr C_PluginInitFunc
val ((FunPtr C_PluginInitFunc -> IO PluginInitFunc)
 -> IO (Maybe PluginInitFunc))
-> (FunPtr C_PluginInitFunc -> IO PluginInitFunc)
-> IO (Maybe PluginInitFunc)
forall a b. (a -> b) -> a -> b
$ \FunPtr C_PluginInitFunc
val' -> do
        let val'' :: PluginInitFunc
val'' = FunPtr C_PluginInitFunc -> PluginInitFunc
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsPlugin a) =>
FunPtr C_PluginInitFunc -> a -> m Bool
Gst.Callbacks.dynamic_PluginInitFunc FunPtr C_PluginInitFunc
val'
        PluginInitFunc -> IO PluginInitFunc
forall (m :: * -> *) a. Monad m => a -> m a
return PluginInitFunc
val''
    Maybe PluginInitFunc -> IO (Maybe PluginInitFunc)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PluginInitFunc
result

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

-- | Set the value of the “@plugin_init@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #pluginInit
-- @
clearPluginDescPluginInit :: MonadIO m => PluginDesc -> m ()
clearPluginDescPluginInit :: PluginDesc -> m ()
clearPluginDescPluginInit PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr (FunPtr C_PluginInitFunc) -> FunPtr C_PluginInitFunc -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr (FunPtr C_PluginInitFunc)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
24) (FunPtr C_PluginInitFunc
forall a. FunPtr a
FP.nullFunPtr :: FunPtr Gst.Callbacks.C_PluginInitFunc)

#if defined(ENABLE_OVERLOADING)
data PluginDescPluginInitFieldInfo
instance AttrInfo PluginDescPluginInitFieldInfo where
    type AttrBaseTypeConstraint PluginDescPluginInitFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescPluginInitFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescPluginInitFieldInfo = (~) (FunPtr Gst.Callbacks.C_PluginInitFunc)
    type AttrTransferTypeConstraint PluginDescPluginInitFieldInfo = (~)Gst.Callbacks.PluginInitFunc
    type AttrTransferType PluginDescPluginInitFieldInfo = (FunPtr Gst.Callbacks.C_PluginInitFunc)
    type AttrGetType PluginDescPluginInitFieldInfo = Maybe Gst.Callbacks.PluginInitFunc
    type AttrLabel PluginDescPluginInitFieldInfo = "plugin_init"
    type AttrOrigin PluginDescPluginInitFieldInfo = PluginDesc
    attrGet = getPluginDescPluginInit
    attrSet = setPluginDescPluginInit
    attrConstruct = undefined
    attrClear = clearPluginDescPluginInit
    attrTransfer _ v = do
        Gst.Callbacks.mk_PluginInitFunc (Gst.Callbacks.wrap_PluginInitFunc Nothing v)

pluginDesc_pluginInit :: AttrLabelProxy "pluginInit"
pluginDesc_pluginInit = AttrLabelProxy

#endif


-- | Get the value of the “@version@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #version
-- @
getPluginDescVersion :: MonadIO m => PluginDesc -> m (Maybe T.Text)
getPluginDescVersion :: PluginDesc -> m (Maybe Text)
getPluginDescVersion PluginDesc
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@version@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #version
-- @
clearPluginDescVersion :: MonadIO m => PluginDesc -> m ()
clearPluginDescVersion :: PluginDesc -> m ()
clearPluginDescVersion PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
32) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PluginDescVersionFieldInfo
instance AttrInfo PluginDescVersionFieldInfo where
    type AttrBaseTypeConstraint PluginDescVersionFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescVersionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescVersionFieldInfo = (~) CString
    type AttrTransferTypeConstraint PluginDescVersionFieldInfo = (~)CString
    type AttrTransferType PluginDescVersionFieldInfo = CString
    type AttrGetType PluginDescVersionFieldInfo = Maybe T.Text
    type AttrLabel PluginDescVersionFieldInfo = "version"
    type AttrOrigin PluginDescVersionFieldInfo = PluginDesc
    attrGet = getPluginDescVersion
    attrSet = setPluginDescVersion
    attrConstruct = undefined
    attrClear = clearPluginDescVersion
    attrTransfer _ v = do
        return v

pluginDesc_version :: AttrLabelProxy "version"
pluginDesc_version = AttrLabelProxy

#endif


-- | Get the value of the “@license@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #license
-- @
getPluginDescLicense :: MonadIO m => PluginDesc -> m (Maybe T.Text)
getPluginDescLicense :: PluginDesc -> m (Maybe Text)
getPluginDescLicense PluginDesc
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@license@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #license
-- @
clearPluginDescLicense :: MonadIO m => PluginDesc -> m ()
clearPluginDescLicense :: PluginDesc -> m ()
clearPluginDescLicense PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
40) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PluginDescLicenseFieldInfo
instance AttrInfo PluginDescLicenseFieldInfo where
    type AttrBaseTypeConstraint PluginDescLicenseFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescLicenseFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescLicenseFieldInfo = (~) CString
    type AttrTransferTypeConstraint PluginDescLicenseFieldInfo = (~)CString
    type AttrTransferType PluginDescLicenseFieldInfo = CString
    type AttrGetType PluginDescLicenseFieldInfo = Maybe T.Text
    type AttrLabel PluginDescLicenseFieldInfo = "license"
    type AttrOrigin PluginDescLicenseFieldInfo = PluginDesc
    attrGet = getPluginDescLicense
    attrSet = setPluginDescLicense
    attrConstruct = undefined
    attrClear = clearPluginDescLicense
    attrTransfer _ v = do
        return v

pluginDesc_license :: AttrLabelProxy "license"
pluginDesc_license = AttrLabelProxy

#endif


-- | Get the value of the “@source@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #source
-- @
getPluginDescSource :: MonadIO m => PluginDesc -> m (Maybe T.Text)
getPluginDescSource :: PluginDesc -> m (Maybe Text)
getPluginDescSource PluginDesc
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@source@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #source
-- @
clearPluginDescSource :: MonadIO m => PluginDesc -> m ()
clearPluginDescSource :: PluginDesc -> m ()
clearPluginDescSource PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
48) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PluginDescSourceFieldInfo
instance AttrInfo PluginDescSourceFieldInfo where
    type AttrBaseTypeConstraint PluginDescSourceFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescSourceFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescSourceFieldInfo = (~) CString
    type AttrTransferTypeConstraint PluginDescSourceFieldInfo = (~)CString
    type AttrTransferType PluginDescSourceFieldInfo = CString
    type AttrGetType PluginDescSourceFieldInfo = Maybe T.Text
    type AttrLabel PluginDescSourceFieldInfo = "source"
    type AttrOrigin PluginDescSourceFieldInfo = PluginDesc
    attrGet = getPluginDescSource
    attrSet = setPluginDescSource
    attrConstruct = undefined
    attrClear = clearPluginDescSource
    attrTransfer _ v = do
        return v

pluginDesc_source :: AttrLabelProxy "source"
pluginDesc_source = AttrLabelProxy

#endif


-- | Get the value of the “@package@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #package
-- @
getPluginDescPackage :: MonadIO m => PluginDesc -> m (Maybe T.Text)
getPluginDescPackage :: PluginDesc -> m (Maybe Text)
getPluginDescPackage PluginDesc
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@package@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #package
-- @
clearPluginDescPackage :: MonadIO m => PluginDesc -> m ()
clearPluginDescPackage :: PluginDesc -> m ()
clearPluginDescPackage PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
56) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PluginDescPackageFieldInfo
instance AttrInfo PluginDescPackageFieldInfo where
    type AttrBaseTypeConstraint PluginDescPackageFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescPackageFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescPackageFieldInfo = (~) CString
    type AttrTransferTypeConstraint PluginDescPackageFieldInfo = (~)CString
    type AttrTransferType PluginDescPackageFieldInfo = CString
    type AttrGetType PluginDescPackageFieldInfo = Maybe T.Text
    type AttrLabel PluginDescPackageFieldInfo = "package"
    type AttrOrigin PluginDescPackageFieldInfo = PluginDesc
    attrGet = getPluginDescPackage
    attrSet = setPluginDescPackage
    attrConstruct = undefined
    attrClear = clearPluginDescPackage
    attrTransfer _ v = do
        return v

pluginDesc_package :: AttrLabelProxy "package"
pluginDesc_package = AttrLabelProxy

#endif


-- | Get the value of the “@origin@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #origin
-- @
getPluginDescOrigin :: MonadIO m => PluginDesc -> m (Maybe T.Text)
getPluginDescOrigin :: PluginDesc -> m (Maybe Text)
getPluginDescOrigin PluginDesc
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@origin@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #origin
-- @
clearPluginDescOrigin :: MonadIO m => PluginDesc -> m ()
clearPluginDescOrigin :: PluginDesc -> m ()
clearPluginDescOrigin PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
64) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PluginDescOriginFieldInfo
instance AttrInfo PluginDescOriginFieldInfo where
    type AttrBaseTypeConstraint PluginDescOriginFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescOriginFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescOriginFieldInfo = (~) CString
    type AttrTransferTypeConstraint PluginDescOriginFieldInfo = (~)CString
    type AttrTransferType PluginDescOriginFieldInfo = CString
    type AttrGetType PluginDescOriginFieldInfo = Maybe T.Text
    type AttrLabel PluginDescOriginFieldInfo = "origin"
    type AttrOrigin PluginDescOriginFieldInfo = PluginDesc
    attrGet = getPluginDescOrigin
    attrSet = setPluginDescOrigin
    attrConstruct = undefined
    attrClear = clearPluginDescOrigin
    attrTransfer _ v = do
        return v

pluginDesc_origin :: AttrLabelProxy "origin"
pluginDesc_origin = AttrLabelProxy

#endif


-- | Get the value of the “@release_datetime@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' pluginDesc #releaseDatetime
-- @
getPluginDescReleaseDatetime :: MonadIO m => PluginDesc -> m (Maybe T.Text)
getPluginDescReleaseDatetime :: PluginDesc -> m (Maybe Text)
getPluginDescReleaseDatetime PluginDesc
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ PluginDesc
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr PluginDesc -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

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

-- | Set the value of the “@release_datetime@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #releaseDatetime
-- @
clearPluginDescReleaseDatetime :: MonadIO m => PluginDesc -> m ()
clearPluginDescReleaseDatetime :: PluginDesc -> m ()
clearPluginDescReleaseDatetime PluginDesc
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PluginDesc -> (Ptr PluginDesc -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PluginDesc
s ((Ptr PluginDesc -> IO ()) -> IO ())
-> (Ptr PluginDesc -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PluginDesc
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PluginDesc
ptr Ptr PluginDesc -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
72) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PluginDescReleaseDatetimeFieldInfo
instance AttrInfo PluginDescReleaseDatetimeFieldInfo where
    type AttrBaseTypeConstraint PluginDescReleaseDatetimeFieldInfo = (~) PluginDesc
    type AttrAllowedOps PluginDescReleaseDatetimeFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PluginDescReleaseDatetimeFieldInfo = (~) CString
    type AttrTransferTypeConstraint PluginDescReleaseDatetimeFieldInfo = (~)CString
    type AttrTransferType PluginDescReleaseDatetimeFieldInfo = CString
    type AttrGetType PluginDescReleaseDatetimeFieldInfo = Maybe T.Text
    type AttrLabel PluginDescReleaseDatetimeFieldInfo = "release_datetime"
    type AttrOrigin PluginDescReleaseDatetimeFieldInfo = PluginDesc
    attrGet = getPluginDescReleaseDatetime
    attrSet = setPluginDescReleaseDatetime
    attrConstruct = undefined
    attrClear = clearPluginDescReleaseDatetime
    attrTransfer _ v = do
        return v

pluginDesc_releaseDatetime :: AttrLabelProxy "releaseDatetime"
pluginDesc_releaseDatetime = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PluginDesc
type instance O.AttributeList PluginDesc = PluginDescAttributeList
type PluginDescAttributeList = ('[ '("majorVersion", PluginDescMajorVersionFieldInfo), '("minorVersion", PluginDescMinorVersionFieldInfo), '("name", PluginDescNameFieldInfo), '("description", PluginDescDescriptionFieldInfo), '("pluginInit", PluginDescPluginInitFieldInfo), '("version", PluginDescVersionFieldInfo), '("license", PluginDescLicenseFieldInfo), '("source", PluginDescSourceFieldInfo), '("package", PluginDescPackageFieldInfo), '("origin", PluginDescOriginFieldInfo), '("releaseDatetime", PluginDescReleaseDatetimeFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif