{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A format definition

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

module GI.Gst.Structs.FormatDefinition
    ( 

-- * Exported types
    FormatDefinition(..)                    ,
    newZeroFormatDefinition                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveFormatDefinitionMethod           ,
#endif




 -- * Properties
-- ** description #attr:description#
-- | A longer description of the format

    clearFormatDefinitionDescription        ,
#if defined(ENABLE_OVERLOADING)
    formatDefinition_description            ,
#endif
    getFormatDefinitionDescription          ,
    setFormatDefinitionDescription          ,


-- ** nick #attr:nick#
-- | A short nick of the format

    clearFormatDefinitionNick               ,
#if defined(ENABLE_OVERLOADING)
    formatDefinition_nick                   ,
#endif
    getFormatDefinitionNick                 ,
    setFormatDefinitionNick                 ,


-- ** quark #attr:quark#
-- | A quark for the nick

#if defined(ENABLE_OVERLOADING)
    formatDefinition_quark                  ,
#endif
    getFormatDefinitionQuark                ,
    setFormatDefinitionQuark                ,


-- ** value #attr:value#
-- | The unique id of this format

#if defined(ENABLE_OVERLOADING)
    formatDefinition_value                  ,
#endif
    getFormatDefinitionValue                ,
    setFormatDefinitionValue                ,




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

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

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

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


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

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


-- | Get the value of the “@value@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' formatDefinition #value
-- @
getFormatDefinitionValue :: MonadIO m => FormatDefinition -> m Gst.Enums.Format
getFormatDefinitionValue :: FormatDefinition -> m Format
getFormatDefinitionValue FormatDefinition
s = IO Format -> m Format
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Format -> m Format) -> IO Format -> m Format
forall a b. (a -> b) -> a -> b
$ FormatDefinition
-> (Ptr FormatDefinition -> IO Format) -> IO Format
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr FormatDefinition
s ((Ptr FormatDefinition -> IO Format) -> IO Format)
-> (Ptr FormatDefinition -> IO Format) -> IO Format
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDefinition
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr FormatDefinition
ptr Ptr FormatDefinition -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CUInt
    let val' :: Format
val' = (Int -> Format
forall a. Enum a => Int -> a
toEnum (Int -> Format) -> (CUInt -> Int) -> CUInt -> Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
val
    Format -> IO Format
forall (m :: * -> *) a. Monad m => a -> m a
return Format
val'

-- | Set the value of the “@value@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' formatDefinition [ #value 'Data.GI.Base.Attributes.:=' value ]
-- @
setFormatDefinitionValue :: MonadIO m => FormatDefinition -> Gst.Enums.Format -> m ()
setFormatDefinitionValue :: FormatDefinition -> Format -> m ()
setFormatDefinitionValue FormatDefinition
s Format
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FormatDefinition -> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr FormatDefinition
s ((Ptr FormatDefinition -> IO ()) -> IO ())
-> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDefinition
ptr -> do
    let val' :: CUInt
val' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Format -> Int) -> Format -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Int
forall a. Enum a => a -> Int
fromEnum) Format
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr FormatDefinition
ptr Ptr FormatDefinition -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data FormatDefinitionValueFieldInfo
instance AttrInfo FormatDefinitionValueFieldInfo where
    type AttrBaseTypeConstraint FormatDefinitionValueFieldInfo = (~) FormatDefinition
    type AttrAllowedOps FormatDefinitionValueFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint FormatDefinitionValueFieldInfo = (~) Gst.Enums.Format
    type AttrTransferTypeConstraint FormatDefinitionValueFieldInfo = (~)Gst.Enums.Format
    type AttrTransferType FormatDefinitionValueFieldInfo = Gst.Enums.Format
    type AttrGetType FormatDefinitionValueFieldInfo = Gst.Enums.Format
    type AttrLabel FormatDefinitionValueFieldInfo = "value"
    type AttrOrigin FormatDefinitionValueFieldInfo = FormatDefinition
    attrGet = getFormatDefinitionValue
    attrSet = setFormatDefinitionValue
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

formatDefinition_value :: AttrLabelProxy "value"
formatDefinition_value = AttrLabelProxy

#endif


-- | Get the value of the “@nick@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' formatDefinition #nick
-- @
getFormatDefinitionNick :: MonadIO m => FormatDefinition -> m (Maybe T.Text)
getFormatDefinitionNick :: FormatDefinition -> m (Maybe Text)
getFormatDefinitionNick FormatDefinition
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
$ FormatDefinition
-> (Ptr FormatDefinition -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr FormatDefinition
s ((Ptr FormatDefinition -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr FormatDefinition -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDefinition
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr FormatDefinition
ptr Ptr FormatDefinition -> 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 “@nick@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' formatDefinition [ #nick 'Data.GI.Base.Attributes.:=' value ]
-- @
setFormatDefinitionNick :: MonadIO m => FormatDefinition -> CString -> m ()
setFormatDefinitionNick :: FormatDefinition -> CString -> m ()
setFormatDefinitionNick FormatDefinition
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
$ FormatDefinition -> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr FormatDefinition
s ((Ptr FormatDefinition -> IO ()) -> IO ())
-> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDefinition
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr FormatDefinition
ptr Ptr FormatDefinition -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (CString
val :: CString)

-- | Set the value of the “@nick@” 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' #nick
-- @
clearFormatDefinitionNick :: MonadIO m => FormatDefinition -> m ()
clearFormatDefinitionNick :: FormatDefinition -> m ()
clearFormatDefinitionNick FormatDefinition
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FormatDefinition -> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr FormatDefinition
s ((Ptr FormatDefinition -> IO ()) -> IO ())
-> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDefinition
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr FormatDefinition
ptr Ptr FormatDefinition -> 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 FormatDefinitionNickFieldInfo
instance AttrInfo FormatDefinitionNickFieldInfo where
    type AttrBaseTypeConstraint FormatDefinitionNickFieldInfo = (~) FormatDefinition
    type AttrAllowedOps FormatDefinitionNickFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint FormatDefinitionNickFieldInfo = (~) CString
    type AttrTransferTypeConstraint FormatDefinitionNickFieldInfo = (~)CString
    type AttrTransferType FormatDefinitionNickFieldInfo = CString
    type AttrGetType FormatDefinitionNickFieldInfo = Maybe T.Text
    type AttrLabel FormatDefinitionNickFieldInfo = "nick"
    type AttrOrigin FormatDefinitionNickFieldInfo = FormatDefinition
    attrGet = getFormatDefinitionNick
    attrSet = setFormatDefinitionNick
    attrConstruct = undefined
    attrClear = clearFormatDefinitionNick
    attrTransfer _ v = do
        return v

formatDefinition_nick :: AttrLabelProxy "nick"
formatDefinition_nick = 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' formatDefinition #description
-- @
getFormatDefinitionDescription :: MonadIO m => FormatDefinition -> m (Maybe T.Text)
getFormatDefinitionDescription :: FormatDefinition -> m (Maybe Text)
getFormatDefinitionDescription FormatDefinition
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
$ FormatDefinition
-> (Ptr FormatDefinition -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr FormatDefinition
s ((Ptr FormatDefinition -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr FormatDefinition -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDefinition
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr FormatDefinition
ptr Ptr FormatDefinition -> 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' formatDefinition [ #description 'Data.GI.Base.Attributes.:=' value ]
-- @
setFormatDefinitionDescription :: MonadIO m => FormatDefinition -> CString -> m ()
setFormatDefinitionDescription :: FormatDefinition -> CString -> m ()
setFormatDefinitionDescription FormatDefinition
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
$ FormatDefinition -> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr FormatDefinition
s ((Ptr FormatDefinition -> IO ()) -> IO ())
-> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDefinition
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr FormatDefinition
ptr Ptr FormatDefinition -> 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
-- @
clearFormatDefinitionDescription :: MonadIO m => FormatDefinition -> m ()
clearFormatDefinitionDescription :: FormatDefinition -> m ()
clearFormatDefinitionDescription FormatDefinition
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FormatDefinition -> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr FormatDefinition
s ((Ptr FormatDefinition -> IO ()) -> IO ())
-> (Ptr FormatDefinition -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr FormatDefinition
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr FormatDefinition
ptr Ptr FormatDefinition -> 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 FormatDefinitionDescriptionFieldInfo
instance AttrInfo FormatDefinitionDescriptionFieldInfo where
    type AttrBaseTypeConstraint FormatDefinitionDescriptionFieldInfo = (~) FormatDefinition
    type AttrAllowedOps FormatDefinitionDescriptionFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint FormatDefinitionDescriptionFieldInfo = (~) CString
    type AttrTransferTypeConstraint FormatDefinitionDescriptionFieldInfo = (~)CString
    type AttrTransferType FormatDefinitionDescriptionFieldInfo = CString
    type AttrGetType FormatDefinitionDescriptionFieldInfo = Maybe T.Text
    type AttrLabel FormatDefinitionDescriptionFieldInfo = "description"
    type AttrOrigin FormatDefinitionDescriptionFieldInfo = FormatDefinition
    attrGet = getFormatDefinitionDescription
    attrSet = setFormatDefinitionDescription
    attrConstruct = undefined
    attrClear = clearFormatDefinitionDescription
    attrTransfer _ v = do
        return v

formatDefinition_description :: AttrLabelProxy "description"
formatDefinition_description = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data FormatDefinitionQuarkFieldInfo
instance AttrInfo FormatDefinitionQuarkFieldInfo where
    type AttrBaseTypeConstraint FormatDefinitionQuarkFieldInfo = (~) FormatDefinition
    type AttrAllowedOps FormatDefinitionQuarkFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint FormatDefinitionQuarkFieldInfo = (~) Word32
    type AttrTransferTypeConstraint FormatDefinitionQuarkFieldInfo = (~)Word32
    type AttrTransferType FormatDefinitionQuarkFieldInfo = Word32
    type AttrGetType FormatDefinitionQuarkFieldInfo = Word32
    type AttrLabel FormatDefinitionQuarkFieldInfo = "quark"
    type AttrOrigin FormatDefinitionQuarkFieldInfo = FormatDefinition
    attrGet = getFormatDefinitionQuark
    attrSet = setFormatDefinitionQuark
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

formatDefinition_quark :: AttrLabelProxy "quark"
formatDefinition_quark = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList FormatDefinition
type instance O.AttributeList FormatDefinition = FormatDefinitionAttributeList
type FormatDefinitionAttributeList = ('[ '("value", FormatDefinitionValueFieldInfo), '("nick", FormatDefinitionNickFieldInfo), '("description", FormatDefinitionDescriptionFieldInfo), '("quark", FormatDefinitionQuarkFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif