{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.OSTree.Structs.RollsumMatches
    ( 

-- * Exported types
    RollsumMatches(..)                      ,
    newZeroRollsumMatches                   ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRollsumMatchesMethod             ,
#endif




 -- * Properties
-- ** bufmatches #attr:bufmatches#
-- | /No description available in the introspection data./

    getRollsumMatchesBufmatches             ,
#if defined(ENABLE_OVERLOADING)
    rollsumMatches_bufmatches               ,
#endif
    setRollsumMatchesBufmatches             ,


-- ** crcmatches #attr:crcmatches#
-- | /No description available in the introspection data./

    getRollsumMatchesCrcmatches             ,
#if defined(ENABLE_OVERLOADING)
    rollsumMatches_crcmatches               ,
#endif
    setRollsumMatchesCrcmatches             ,


-- ** fromRollsums #attr:fromRollsums#
-- | /No description available in the introspection data./

    clearRollsumMatchesFromRollsums         ,
    getRollsumMatchesFromRollsums           ,
#if defined(ENABLE_OVERLOADING)
    rollsumMatches_fromRollsums             ,
#endif
    setRollsumMatchesFromRollsums           ,


-- ** matchSize #attr:matchSize#
-- | /No description available in the introspection data./

    getRollsumMatchesMatchSize              ,
#if defined(ENABLE_OVERLOADING)
    rollsumMatches_matchSize                ,
#endif
    setRollsumMatchesMatchSize              ,


-- ** matches #attr:matches#
-- | /No description available in the introspection data./

    clearRollsumMatchesMatches              ,
    getRollsumMatchesMatches                ,
#if defined(ENABLE_OVERLOADING)
    rollsumMatches_matches                  ,
#endif
    setRollsumMatchesMatches                ,


-- ** toRollsums #attr:toRollsums#
-- | /No description available in the introspection data./

    clearRollsumMatchesToRollsums           ,
    getRollsumMatchesToRollsums             ,
#if defined(ENABLE_OVERLOADING)
    rollsumMatches_toRollsums               ,
#endif
    setRollsumMatchesToRollsums             ,


-- ** total #attr:total#
-- | /No description available in the introspection data./

    getRollsumMatchesTotal                  ,
#if defined(ENABLE_OVERLOADING)
    rollsumMatches_total                    ,
#endif
    setRollsumMatchesTotal                  ,




    ) 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


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

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

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


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

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


-- | Get the value of the “@from_rollsums@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rollsumMatches #fromRollsums
-- @
getRollsumMatchesFromRollsums :: MonadIO m => RollsumMatches -> m (Maybe (Map.Map (Ptr ()) (Ptr ())))
getRollsumMatchesFromRollsums :: RollsumMatches -> m (Maybe (Map (Ptr ()) (Ptr ())))
getRollsumMatchesFromRollsums RollsumMatches
s = IO (Maybe (Map (Ptr ()) (Ptr ())))
-> m (Maybe (Map (Ptr ()) (Ptr ())))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Map (Ptr ()) (Ptr ())))
 -> m (Maybe (Map (Ptr ()) (Ptr ()))))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
-> m (Maybe (Map (Ptr ()) (Ptr ())))
forall a b. (a -> b) -> a -> b
$ RollsumMatches
-> (Ptr RollsumMatches -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr RollsumMatches
s ((Ptr RollsumMatches -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
 -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
-> (Ptr RollsumMatches -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall a b. (a -> b) -> a -> b
$ \Ptr RollsumMatches
ptr -> do
    Ptr (GHashTable (Ptr ()) (Ptr ()))
val <- Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek (Ptr RollsumMatches
ptr Ptr RollsumMatches
-> Int -> Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
    Maybe (Map (Ptr ()) (Ptr ()))
result <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> (Ptr (GHashTable (Ptr ()) (Ptr ()))
    -> IO (Map (Ptr ()) (Ptr ())))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr (GHashTable (Ptr ()) (Ptr ()))
val ((Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO (Map (Ptr ()) (Ptr ())))
 -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
-> (Ptr (GHashTable (Ptr ()) (Ptr ()))
    -> IO (Map (Ptr ()) (Ptr ())))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall a b. (a -> b) -> a -> b
$ \Ptr (GHashTable (Ptr ()) (Ptr ()))
val' -> do
        [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
val'' <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
val'
        let val''' :: [(Ptr (), PtrWrapped (Ptr ()))]
val''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> [(Ptr (), PtrWrapped (Ptr ()))]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
ptrUnpackPtr [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
val''
        let val'''' :: [(Ptr (), Ptr ())]
val'''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(Ptr (), PtrWrapped (Ptr ()))] -> [(Ptr (), Ptr ())]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
ptrUnpackPtr [(Ptr (), PtrWrapped (Ptr ()))]
val'''
        let val''''' :: Map (Ptr ()) (Ptr ())
val''''' = [(Ptr (), Ptr ())] -> Map (Ptr ()) (Ptr ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Ptr (), Ptr ())]
val''''
        Map (Ptr ()) (Ptr ()) -> IO (Map (Ptr ()) (Ptr ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Map (Ptr ()) (Ptr ())
val'''''
    Maybe (Map (Ptr ()) (Ptr ())) -> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map (Ptr ()) (Ptr ()))
result

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

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

#if defined(ENABLE_OVERLOADING)
data RollsumMatchesFromRollsumsFieldInfo
instance AttrInfo RollsumMatchesFromRollsumsFieldInfo where
    type AttrBaseTypeConstraint RollsumMatchesFromRollsumsFieldInfo = (~) RollsumMatches
    type AttrAllowedOps RollsumMatchesFromRollsumsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint RollsumMatchesFromRollsumsFieldInfo = (~) (Ptr (GHashTable (Ptr ()) (Ptr ())))
    type AttrTransferTypeConstraint RollsumMatchesFromRollsumsFieldInfo = (~)(Ptr (GHashTable (Ptr ()) (Ptr ())))
    type AttrTransferType RollsumMatchesFromRollsumsFieldInfo = (Ptr (GHashTable (Ptr ()) (Ptr ())))
    type AttrGetType RollsumMatchesFromRollsumsFieldInfo = Maybe (Map.Map (Ptr ()) (Ptr ()))
    type AttrLabel RollsumMatchesFromRollsumsFieldInfo = "from_rollsums"
    type AttrOrigin RollsumMatchesFromRollsumsFieldInfo = RollsumMatches
    attrGet = getRollsumMatchesFromRollsums
    attrSet = setRollsumMatchesFromRollsums
    attrConstruct = undefined
    attrClear = clearRollsumMatchesFromRollsums
    attrTransfer _ v = do
        return v

rollsumMatches_fromRollsums :: AttrLabelProxy "fromRollsums"
rollsumMatches_fromRollsums = AttrLabelProxy

#endif


-- | Get the value of the “@to_rollsums@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' rollsumMatches #toRollsums
-- @
getRollsumMatchesToRollsums :: MonadIO m => RollsumMatches -> m (Maybe (Map.Map (Ptr ()) (Ptr ())))
getRollsumMatchesToRollsums :: RollsumMatches -> m (Maybe (Map (Ptr ()) (Ptr ())))
getRollsumMatchesToRollsums RollsumMatches
s = IO (Maybe (Map (Ptr ()) (Ptr ())))
-> m (Maybe (Map (Ptr ()) (Ptr ())))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Map (Ptr ()) (Ptr ())))
 -> m (Maybe (Map (Ptr ()) (Ptr ()))))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
-> m (Maybe (Map (Ptr ()) (Ptr ())))
forall a b. (a -> b) -> a -> b
$ RollsumMatches
-> (Ptr RollsumMatches -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr RollsumMatches
s ((Ptr RollsumMatches -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
 -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
-> (Ptr RollsumMatches -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall a b. (a -> b) -> a -> b
$ \Ptr RollsumMatches
ptr -> do
    Ptr (GHashTable (Ptr ()) (Ptr ()))
val <- Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a. Storable a => Ptr a -> IO a
peek (Ptr RollsumMatches
ptr Ptr RollsumMatches
-> Int -> Ptr (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
    Maybe (Map (Ptr ()) (Ptr ()))
result <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> (Ptr (GHashTable (Ptr ()) (Ptr ()))
    -> IO (Map (Ptr ()) (Ptr ())))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr (GHashTable (Ptr ()) (Ptr ()))
val ((Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO (Map (Ptr ()) (Ptr ())))
 -> IO (Maybe (Map (Ptr ()) (Ptr ()))))
-> (Ptr (GHashTable (Ptr ()) (Ptr ()))
    -> IO (Map (Ptr ()) (Ptr ())))
-> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall a b. (a -> b) -> a -> b
$ \Ptr (GHashTable (Ptr ()) (Ptr ()))
val' -> do
        [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
val'' <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> IO [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall a b.
Ptr (GHashTable a b) -> IO [(PtrWrapped a, PtrWrapped b)]
unpackGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
val'
        let val''' :: [(Ptr (), PtrWrapped (Ptr ()))]
val''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> [(Ptr (), PtrWrapped (Ptr ()))]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
ptrUnpackPtr [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
val''
        let val'''' :: [(Ptr (), Ptr ())]
val'''' = (PtrWrapped (Ptr ()) -> Ptr ())
-> [(Ptr (), PtrWrapped (Ptr ()))] -> [(Ptr (), Ptr ())]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond PtrWrapped (Ptr ()) -> Ptr ()
forall a. PtrWrapped (Ptr a) -> Ptr a
ptrUnpackPtr [(Ptr (), PtrWrapped (Ptr ()))]
val'''
        let val''''' :: Map (Ptr ()) (Ptr ())
val''''' = [(Ptr (), Ptr ())] -> Map (Ptr ()) (Ptr ())
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Ptr (), Ptr ())]
val''''
        Map (Ptr ()) (Ptr ()) -> IO (Map (Ptr ()) (Ptr ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Map (Ptr ()) (Ptr ())
val'''''
    Maybe (Map (Ptr ()) (Ptr ())) -> IO (Maybe (Map (Ptr ()) (Ptr ())))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map (Ptr ()) (Ptr ()))
result

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

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

#if defined(ENABLE_OVERLOADING)
data RollsumMatchesToRollsumsFieldInfo
instance AttrInfo RollsumMatchesToRollsumsFieldInfo where
    type AttrBaseTypeConstraint RollsumMatchesToRollsumsFieldInfo = (~) RollsumMatches
    type AttrAllowedOps RollsumMatchesToRollsumsFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint RollsumMatchesToRollsumsFieldInfo = (~) (Ptr (GHashTable (Ptr ()) (Ptr ())))
    type AttrTransferTypeConstraint RollsumMatchesToRollsumsFieldInfo = (~)(Ptr (GHashTable (Ptr ()) (Ptr ())))
    type AttrTransferType RollsumMatchesToRollsumsFieldInfo = (Ptr (GHashTable (Ptr ()) (Ptr ())))
    type AttrGetType RollsumMatchesToRollsumsFieldInfo = Maybe (Map.Map (Ptr ()) (Ptr ()))
    type AttrLabel RollsumMatchesToRollsumsFieldInfo = "to_rollsums"
    type AttrOrigin RollsumMatchesToRollsumsFieldInfo = RollsumMatches
    attrGet = getRollsumMatchesToRollsums
    attrSet = setRollsumMatchesToRollsums
    attrConstruct = undefined
    attrClear = clearRollsumMatchesToRollsums
    attrTransfer _ v = do
        return v

rollsumMatches_toRollsums :: AttrLabelProxy "toRollsums"
rollsumMatches_toRollsums = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data RollsumMatchesCrcmatchesFieldInfo
instance AttrInfo RollsumMatchesCrcmatchesFieldInfo where
    type AttrBaseTypeConstraint RollsumMatchesCrcmatchesFieldInfo = (~) RollsumMatches
    type AttrAllowedOps RollsumMatchesCrcmatchesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RollsumMatchesCrcmatchesFieldInfo = (~) Word32
    type AttrTransferTypeConstraint RollsumMatchesCrcmatchesFieldInfo = (~)Word32
    type AttrTransferType RollsumMatchesCrcmatchesFieldInfo = Word32
    type AttrGetType RollsumMatchesCrcmatchesFieldInfo = Word32
    type AttrLabel RollsumMatchesCrcmatchesFieldInfo = "crcmatches"
    type AttrOrigin RollsumMatchesCrcmatchesFieldInfo = RollsumMatches
    attrGet = getRollsumMatchesCrcmatches
    attrSet = setRollsumMatchesCrcmatches
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

rollsumMatches_crcmatches :: AttrLabelProxy "crcmatches"
rollsumMatches_crcmatches = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data RollsumMatchesBufmatchesFieldInfo
instance AttrInfo RollsumMatchesBufmatchesFieldInfo where
    type AttrBaseTypeConstraint RollsumMatchesBufmatchesFieldInfo = (~) RollsumMatches
    type AttrAllowedOps RollsumMatchesBufmatchesFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RollsumMatchesBufmatchesFieldInfo = (~) Word32
    type AttrTransferTypeConstraint RollsumMatchesBufmatchesFieldInfo = (~)Word32
    type AttrTransferType RollsumMatchesBufmatchesFieldInfo = Word32
    type AttrGetType RollsumMatchesBufmatchesFieldInfo = Word32
    type AttrLabel RollsumMatchesBufmatchesFieldInfo = "bufmatches"
    type AttrOrigin RollsumMatchesBufmatchesFieldInfo = RollsumMatches
    attrGet = getRollsumMatchesBufmatches
    attrSet = setRollsumMatchesBufmatches
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

rollsumMatches_bufmatches :: AttrLabelProxy "bufmatches"
rollsumMatches_bufmatches = AttrLabelProxy

#endif


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

#if defined(ENABLE_OVERLOADING)
data RollsumMatchesTotalFieldInfo
instance AttrInfo RollsumMatchesTotalFieldInfo where
    type AttrBaseTypeConstraint RollsumMatchesTotalFieldInfo = (~) RollsumMatches
    type AttrAllowedOps RollsumMatchesTotalFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RollsumMatchesTotalFieldInfo = (~) Word32
    type AttrTransferTypeConstraint RollsumMatchesTotalFieldInfo = (~)Word32
    type AttrTransferType RollsumMatchesTotalFieldInfo = Word32
    type AttrGetType RollsumMatchesTotalFieldInfo = Word32
    type AttrLabel RollsumMatchesTotalFieldInfo = "total"
    type AttrOrigin RollsumMatchesTotalFieldInfo = RollsumMatches
    attrGet = getRollsumMatchesTotal
    attrSet = setRollsumMatchesTotal
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

rollsumMatches_total :: AttrLabelProxy "total"
rollsumMatches_total = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data RollsumMatchesMatchSizeFieldInfo
instance AttrInfo RollsumMatchesMatchSizeFieldInfo where
    type AttrBaseTypeConstraint RollsumMatchesMatchSizeFieldInfo = (~) RollsumMatches
    type AttrAllowedOps RollsumMatchesMatchSizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RollsumMatchesMatchSizeFieldInfo = (~) Word64
    type AttrTransferTypeConstraint RollsumMatchesMatchSizeFieldInfo = (~)Word64
    type AttrTransferType RollsumMatchesMatchSizeFieldInfo = Word64
    type AttrGetType RollsumMatchesMatchSizeFieldInfo = Word64
    type AttrLabel RollsumMatchesMatchSizeFieldInfo = "match_size"
    type AttrOrigin RollsumMatchesMatchSizeFieldInfo = RollsumMatches
    attrGet = getRollsumMatchesMatchSize
    attrSet = setRollsumMatchesMatchSize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

rollsumMatches_matchSize :: AttrLabelProxy "matchSize"
rollsumMatches_matchSize = AttrLabelProxy

#endif


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

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

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

#if defined(ENABLE_OVERLOADING)
data RollsumMatchesMatchesFieldInfo
instance AttrInfo RollsumMatchesMatchesFieldInfo where
    type AttrBaseTypeConstraint RollsumMatchesMatchesFieldInfo = (~) RollsumMatches
    type AttrAllowedOps RollsumMatchesMatchesFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint RollsumMatchesMatchesFieldInfo = (~) (Ptr (GPtrArray (Ptr ())))
    type AttrTransferTypeConstraint RollsumMatchesMatchesFieldInfo = (~)(Ptr (GPtrArray (Ptr ())))
    type AttrTransferType RollsumMatchesMatchesFieldInfo = (Ptr (GPtrArray (Ptr ())))
    type AttrGetType RollsumMatchesMatchesFieldInfo = Maybe ([Ptr ()])
    type AttrLabel RollsumMatchesMatchesFieldInfo = "matches"
    type AttrOrigin RollsumMatchesMatchesFieldInfo = RollsumMatches
    attrGet = getRollsumMatchesMatches
    attrSet = setRollsumMatchesMatches
    attrConstruct = undefined
    attrClear = clearRollsumMatchesMatches
    attrTransfer _ v = do
        return v

rollsumMatches_matches :: AttrLabelProxy "matches"
rollsumMatches_matches = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList RollsumMatches
type instance O.AttributeList RollsumMatches = RollsumMatchesAttributeList
type RollsumMatchesAttributeList = ('[ '("fromRollsums", RollsumMatchesFromRollsumsFieldInfo), '("toRollsums", RollsumMatchesToRollsumsFieldInfo), '("crcmatches", RollsumMatchesCrcmatchesFieldInfo), '("bufmatches", RollsumMatchesBufmatchesFieldInfo), '("total", RollsumMatchesTotalFieldInfo), '("matchSize", RollsumMatchesMatchSizeFieldInfo), '("matches", RollsumMatchesMatchesFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif