{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A structure containing the result of a map operation such as
-- 'GI.Gst.Structs.Memory.memoryMap'. It contains the data and size.

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

module GI.Gst.Structs.MapInfo
    ( 

-- * Exported types
    MapInfo(..)                             ,
    newZeroMapInfo                          ,
    noMapInfo                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveMapInfoMethod                    ,
#endif




 -- * Properties
-- ** flags #attr:flags#
-- | flags used when mapping the memory

    getMapInfoFlags                         ,
#if defined(ENABLE_OVERLOADING)
    mapInfo_flags                           ,
#endif
    setMapInfoFlags                         ,


-- ** maxsize #attr:maxsize#
-- | the maximum bytes in /@data@/

    getMapInfoMaxsize                       ,
#if defined(ENABLE_OVERLOADING)
    mapInfo_maxsize                         ,
#endif
    setMapInfoMaxsize                       ,


-- ** memory #attr:memory#
-- | a pointer to the mapped memory

    clearMapInfoMemory                      ,
    getMapInfoMemory                        ,
#if defined(ENABLE_OVERLOADING)
    mapInfo_memory                          ,
#endif
    setMapInfoMemory                        ,


-- ** size #attr:size#
-- | the valid size in /@data@/

    getMapInfoSize                          ,
#if defined(ENABLE_OVERLOADING)
    mapInfo_size                            ,
#endif
    setMapInfoSize                          ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Gst.Flags as Gst.Flags
import {-# SOURCE #-} qualified GI.Gst.Structs.Memory as Gst.Memory

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

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

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


-- | A convenience alias for `Nothing` :: `Maybe` `MapInfo`.
noMapInfo :: Maybe MapInfo
noMapInfo :: Maybe MapInfo
noMapInfo = Maybe MapInfo
forall a. Maybe a
Nothing

-- | Get the value of the “@memory@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mapInfo #memory
-- @
getMapInfoMemory :: MonadIO m => MapInfo -> m (Maybe Gst.Memory.Memory)
getMapInfoMemory :: MapInfo -> m (Maybe Memory)
getMapInfoMemory s :: MapInfo
s = IO (Maybe Memory) -> m (Maybe Memory)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Memory) -> m (Maybe Memory))
-> IO (Maybe Memory) -> m (Maybe Memory)
forall a b. (a -> b) -> a -> b
$ MapInfo -> (Ptr MapInfo -> IO (Maybe Memory)) -> IO (Maybe Memory)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MapInfo
s ((Ptr MapInfo -> IO (Maybe Memory)) -> IO (Maybe Memory))
-> (Ptr MapInfo -> IO (Maybe Memory)) -> IO (Maybe Memory)
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MapInfo
ptr -> do
    Ptr Memory
val <- Ptr (Ptr Memory) -> IO (Ptr Memory)
forall a. Storable a => Ptr a -> IO a
peek (Ptr MapInfo
ptr Ptr MapInfo -> Int -> Ptr (Ptr Memory)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 0) :: IO (Ptr Gst.Memory.Memory)
    Maybe Memory
result <- Ptr Memory -> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull Ptr Memory
val ((Ptr Memory -> IO Memory) -> IO (Maybe Memory))
-> (Ptr Memory -> IO Memory) -> IO (Maybe Memory)
forall a b. (a -> b) -> a -> b
$ \val' :: Ptr Memory
val' -> do
        Memory
val'' <- ((ManagedPtr Memory -> Memory) -> Ptr Memory -> IO Memory
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Memory -> Memory
Gst.Memory.Memory) Ptr Memory
val'
        Memory -> IO Memory
forall (m :: * -> *) a. Monad m => a -> m a
return Memory
val''
    Maybe Memory -> IO (Maybe Memory)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Memory
result

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

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

#if defined(ENABLE_OVERLOADING)
data MapInfoMemoryFieldInfo
instance AttrInfo MapInfoMemoryFieldInfo where
    type AttrBaseTypeConstraint MapInfoMemoryFieldInfo = (~) MapInfo
    type AttrAllowedOps MapInfoMemoryFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MapInfoMemoryFieldInfo = (~) (Ptr Gst.Memory.Memory)
    type AttrTransferTypeConstraint MapInfoMemoryFieldInfo = (~)(Ptr Gst.Memory.Memory)
    type AttrTransferType MapInfoMemoryFieldInfo = (Ptr Gst.Memory.Memory)
    type AttrGetType MapInfoMemoryFieldInfo = Maybe Gst.Memory.Memory
    type AttrLabel MapInfoMemoryFieldInfo = "memory"
    type AttrOrigin MapInfoMemoryFieldInfo = MapInfo
    attrGet = getMapInfoMemory
    attrSet = setMapInfoMemory
    attrConstruct = undefined
    attrClear = clearMapInfoMemory
    attrTransfer _ v = do
        return v

mapInfo_memory :: AttrLabelProxy "memory"
mapInfo_memory = AttrLabelProxy

#endif


-- | Get the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mapInfo #flags
-- @
getMapInfoFlags :: MonadIO m => MapInfo -> m [Gst.Flags.MapFlags]
getMapInfoFlags :: MapInfo -> m [MapFlags]
getMapInfoFlags s :: MapInfo
s = IO [MapFlags] -> m [MapFlags]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [MapFlags] -> m [MapFlags]) -> IO [MapFlags] -> m [MapFlags]
forall a b. (a -> b) -> a -> b
$ MapInfo -> (Ptr MapInfo -> IO [MapFlags]) -> IO [MapFlags]
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MapInfo
s ((Ptr MapInfo -> IO [MapFlags]) -> IO [MapFlags])
-> (Ptr MapInfo -> IO [MapFlags]) -> IO [MapFlags]
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MapInfo
ptr -> do
    CUInt
val <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr MapInfo
ptr Ptr MapInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) :: IO CUInt
    let val' :: [MapFlags]
val' = CUInt -> [MapFlags]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
val
    [MapFlags] -> IO [MapFlags]
forall (m :: * -> *) a. Monad m => a -> m a
return [MapFlags]
val'

-- | Set the value of the “@flags@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' mapInfo [ #flags 'Data.GI.Base.Attributes.:=' value ]
-- @
setMapInfoFlags :: MonadIO m => MapInfo -> [Gst.Flags.MapFlags] -> m ()
setMapInfoFlags :: MapInfo -> [MapFlags] -> m ()
setMapInfoFlags s :: MapInfo
s val :: [MapFlags]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MapInfo -> (Ptr MapInfo -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MapInfo
s ((Ptr MapInfo -> IO ()) -> IO ())
-> (Ptr MapInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MapInfo
ptr -> do
    let val' :: CUInt
val' = [MapFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [MapFlags]
val
    Ptr CUInt -> CUInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MapInfo
ptr Ptr MapInfo -> Int -> Ptr CUInt
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 8) (CUInt
val' :: CUInt)

#if defined(ENABLE_OVERLOADING)
data MapInfoFlagsFieldInfo
instance AttrInfo MapInfoFlagsFieldInfo where
    type AttrBaseTypeConstraint MapInfoFlagsFieldInfo = (~) MapInfo
    type AttrAllowedOps MapInfoFlagsFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MapInfoFlagsFieldInfo = (~) [Gst.Flags.MapFlags]
    type AttrTransferTypeConstraint MapInfoFlagsFieldInfo = (~)[Gst.Flags.MapFlags]
    type AttrTransferType MapInfoFlagsFieldInfo = [Gst.Flags.MapFlags]
    type AttrGetType MapInfoFlagsFieldInfo = [Gst.Flags.MapFlags]
    type AttrLabel MapInfoFlagsFieldInfo = "flags"
    type AttrOrigin MapInfoFlagsFieldInfo = MapInfo
    attrGet = getMapInfoFlags
    attrSet = setMapInfoFlags
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

mapInfo_flags :: AttrLabelProxy "flags"
mapInfo_flags = AttrLabelProxy

#endif


-- XXX Skipped attribute for "MapInfo:data" :: Not implemented: "Don't know how to unpack C array of type TCArray False (-1) 3 (TBasicType TUInt8)"
-- | Get the value of the “@size@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' mapInfo #size
-- @
getMapInfoSize :: MonadIO m => MapInfo -> m Word64
getMapInfoSize :: MapInfo -> m Word64
getMapInfoSize s :: MapInfo
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
$ MapInfo -> (Ptr MapInfo -> IO Word64) -> IO Word64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MapInfo
s ((Ptr MapInfo -> IO Word64) -> IO Word64)
-> (Ptr MapInfo -> IO Word64) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr MapInfo
ptr -> do
    Word64
val <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek (Ptr MapInfo
ptr Ptr MapInfo -> Int -> Ptr Word64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 24) :: IO Word64
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
val

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

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

mapInfo_size :: AttrLabelProxy "size"
mapInfo_size = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data MapInfoMaxsizeFieldInfo
instance AttrInfo MapInfoMaxsizeFieldInfo where
    type AttrBaseTypeConstraint MapInfoMaxsizeFieldInfo = (~) MapInfo
    type AttrAllowedOps MapInfoMaxsizeFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MapInfoMaxsizeFieldInfo = (~) Word64
    type AttrTransferTypeConstraint MapInfoMaxsizeFieldInfo = (~)Word64
    type AttrTransferType MapInfoMaxsizeFieldInfo = Word64
    type AttrGetType MapInfoMaxsizeFieldInfo = Word64
    type AttrLabel MapInfoMaxsizeFieldInfo = "maxsize"
    type AttrOrigin MapInfoMaxsizeFieldInfo = MapInfo
    attrGet = getMapInfoMaxsize
    attrSet = setMapInfoMaxsize
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

mapInfo_maxsize :: AttrLabelProxy "maxsize"
mapInfo_maxsize = AttrLabelProxy

#endif


-- XXX Skipped attribute for "MapInfo:user_data" :: Not implemented: "Don't know how to unpack C array of type TCArray False 4 (-1) (TBasicType TPtr)"

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MapInfo
type instance O.AttributeList MapInfo = MapInfoAttributeList
type MapInfoAttributeList = ('[ '("memory", MapInfoMemoryFieldInfo), '("flags", MapInfoFlagsFieldInfo), '("size", MapInfoSizeFieldInfo), '("maxsize", MapInfoMaxsizeFieldInfo)] :: [(Symbol, *)])
#endif

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

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

#endif