{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The signature prefix for a module.
-- 
-- The signature of a module is a set of prefixes. Prefixes are encoded as
-- pairs of ordinary strings, where the second string, called the mask, if
-- not @NULL@, must be of the same length as the first one and may contain
-- \' \', \'!\', \'x\', \'z\', and \'n\' to indicate bytes that must be matched,
-- not matched, \"don\'t-care\"-bytes, zeros and non-zeros, respectively.
-- 
-- Each prefix has an associated integer that describes the relevance of
-- the prefix, with 0 meaning a mismatch and 100 a \"perfect match\".
-- 
-- Starting with gdk-pixbuf 2.8, the first byte of the mask may be \'*\',
-- indicating an unanchored pattern that matches not only at the beginning,
-- but also in the middle. Versions prior to 2.8 will interpret the \'*\'
-- like an \'x\'.
-- 
-- The signature of a module is stored as an array of
-- @GdkPixbufModulePatterns@. The array is terminated by a pattern
-- where the @prefix@ is @NULL@.
-- 
-- \`\`@c
-- GdkPixbufModulePattern *signature[] = {
--   { \"abcdx\", \" !x z\", 100 },
--   { \"bla\", NULL,  90 },
--   { NULL, NULL, 0 }
-- };
-- @\`\`
-- 
-- In the example above, the signature matches e.g. \"auud\\0\" with
-- relevance 100, and \"blau\" with relevance 90.
-- 
-- /Since: 2.2/

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

module GI.GdkPixbuf.Structs.PixbufModulePattern
    ( 

-- * Exported types
    PixbufModulePattern(..)                 ,
    newZeroPixbufModulePattern              ,


 -- * Methods

#if defined(ENABLE_OVERLOADING)
    ResolvePixbufModulePatternMethod        ,
#endif



 -- * Properties


-- ** mask #attr:mask#
-- | mask containing bytes which modify how the prefix is matched against
--  test data

    clearPixbufModulePatternMask            ,
    getPixbufModulePatternMask              ,
#if defined(ENABLE_OVERLOADING)
    pixbufModulePattern_mask                ,
#endif
    setPixbufModulePatternMask              ,


-- ** prefix #attr:prefix#
-- | the prefix for this pattern

    clearPixbufModulePatternPrefix          ,
    getPixbufModulePatternPrefix            ,
#if defined(ENABLE_OVERLOADING)
    pixbufModulePattern_prefix              ,
#endif
    setPixbufModulePatternPrefix            ,


-- ** relevance #attr:relevance#
-- | relevance of this pattern

    getPixbufModulePatternRelevance         ,
#if defined(ENABLE_OVERLOADING)
    pixbufModulePattern_relevance           ,
#endif
    setPixbufModulePatternRelevance         ,




    ) 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.GArray as B.GArray
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 GHC.Records as R


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

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

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


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

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


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

-- | Set the value of the “@prefix@” 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' #prefix
-- @
clearPixbufModulePatternPrefix :: MonadIO m => PixbufModulePattern -> m ()
clearPixbufModulePatternPrefix :: forall (m :: * -> *). MonadIO m => PixbufModulePattern -> m ()
clearPixbufModulePatternPrefix PixbufModulePattern
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ PixbufModulePattern -> (Ptr PixbufModulePattern -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr PixbufModulePattern
s ((Ptr PixbufModulePattern -> IO ()) -> IO ())
-> (Ptr PixbufModulePattern -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr PixbufModulePattern
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr PixbufModulePattern
ptr Ptr PixbufModulePattern -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data PixbufModulePatternPrefixFieldInfo
instance AttrInfo PixbufModulePatternPrefixFieldInfo where
    type AttrBaseTypeConstraint PixbufModulePatternPrefixFieldInfo = (~) PixbufModulePattern
    type AttrAllowedOps PixbufModulePatternPrefixFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint PixbufModulePatternPrefixFieldInfo = (~) CString
    type AttrTransferTypeConstraint PixbufModulePatternPrefixFieldInfo = (~)CString
    type AttrTransferType PixbufModulePatternPrefixFieldInfo = CString
    type AttrGetType PixbufModulePatternPrefixFieldInfo = Maybe T.Text
    type AttrLabel PixbufModulePatternPrefixFieldInfo = "prefix"
    type AttrOrigin PixbufModulePatternPrefixFieldInfo = PixbufModulePattern
    attrGet = getPixbufModulePatternPrefix
    attrSet = setPixbufModulePatternPrefix
    attrConstruct = undefined
    attrClear = clearPixbufModulePatternPrefix
    attrTransfer _ v = do
        return v

pixbufModulePattern_prefix :: AttrLabelProxy "prefix"
pixbufModulePattern_prefix = AttrLabelProxy

#endif


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

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

pixbufModulePattern_mask :: AttrLabelProxy "mask"
pixbufModulePattern_mask = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data PixbufModulePatternRelevanceFieldInfo
instance AttrInfo PixbufModulePatternRelevanceFieldInfo where
    type AttrBaseTypeConstraint PixbufModulePatternRelevanceFieldInfo = (~) PixbufModulePattern
    type AttrAllowedOps PixbufModulePatternRelevanceFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint PixbufModulePatternRelevanceFieldInfo = (~) Int32
    type AttrTransferTypeConstraint PixbufModulePatternRelevanceFieldInfo = (~)Int32
    type AttrTransferType PixbufModulePatternRelevanceFieldInfo = Int32
    type AttrGetType PixbufModulePatternRelevanceFieldInfo = Int32
    type AttrLabel PixbufModulePatternRelevanceFieldInfo = "relevance"
    type AttrOrigin PixbufModulePatternRelevanceFieldInfo = PixbufModulePattern
    attrGet = getPixbufModulePatternRelevance
    attrSet = setPixbufModulePatternRelevance
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

pixbufModulePattern_relevance :: AttrLabelProxy "relevance"
pixbufModulePattern_relevance = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList PixbufModulePattern
type instance O.AttributeList PixbufModulePattern = PixbufModulePatternAttributeList
type PixbufModulePatternAttributeList = ('[ '("prefix", PixbufModulePatternPrefixFieldInfo), '("mask", PixbufModulePatternMaskFieldInfo), '("relevance", PixbufModulePatternRelevanceFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolvePixbufModulePatternMethod t PixbufModulePattern, O.OverloadedMethod info PixbufModulePattern p, R.HasField t PixbufModulePattern p) => R.HasField t PixbufModulePattern p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolvePixbufModulePatternMethod t PixbufModulePattern, O.OverloadedMethodInfo info PixbufModulePattern) => OL.IsLabel t (O.MethodProxy info PixbufModulePattern) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif