{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.Dazzle.Structs.Ring
    ( 

-- * Exported types
    Ring(..)                                ,
    newZeroRing                             ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendVals]("GI.Dazzle.Structs.Ring#g:method:appendVals"), [foreach]("GI.Dazzle.Structs.Ring#g:method:foreach"), [ref]("GI.Dazzle.Structs.Ring#g:method:ref"), [unref]("GI.Dazzle.Structs.Ring#g:method:unref").
-- 
-- ==== Getters
-- /None/.
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveRingMethod                       ,
#endif

-- ** appendVals #method:appendVals#

#if defined(ENABLE_OVERLOADING)
    RingAppendValsMethodInfo                ,
#endif
    ringAppendVals                          ,


-- ** foreach #method:foreach#

#if defined(ENABLE_OVERLOADING)
    RingForeachMethodInfo                   ,
#endif
    ringForeach                             ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    RingRefMethodInfo                       ,
#endif
    ringRef                                 ,


-- ** sizedNew #method:sizedNew#

    ringSizedNew                            ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    RingUnrefMethodInfo                     ,
#endif
    ringUnref                               ,




 -- * Properties


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

    getRingData                             ,
#if defined(ENABLE_OVERLOADING)
    ring_data                               ,
#endif
    setRingData                             ,


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

    getRingLen                              ,
#if defined(ENABLE_OVERLOADING)
    ring_len                                ,
#endif
    setRingLen                              ,


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

    getRingPos                              ,
#if defined(ENABLE_OVERLOADING)
    ring_pos                                ,
#endif
    setRingPos                              ,




    ) 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.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Callbacks as GLib.Callbacks

#else
import qualified GI.GLib.Callbacks as GLib.Callbacks

#endif

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

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

foreign import ccall "dzl_ring_get_type" c_dzl_ring_get_type :: 
    IO GType

type instance O.ParentTypes Ring = '[]
instance O.HasParentTypes Ring

instance B.Types.TypedObject Ring where
    glibType :: IO GType
glibType = IO GType
c_dzl_ring_get_type

instance B.Types.GBoxed Ring

-- | Convert 'Ring' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe Ring) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_dzl_ring_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Ring -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Ring
P.Nothing = Ptr GValue -> Ptr Ring -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Ring
forall a. Ptr a
FP.nullPtr :: FP.Ptr Ring)
    gvalueSet_ Ptr GValue
gv (P.Just Ring
obj) = Ring -> (Ptr Ring -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Ring
obj (Ptr GValue -> Ptr Ring -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Ring)
gvalueGet_ Ptr GValue
gv = do
        Ptr Ring
ptr <- Ptr GValue -> IO (Ptr Ring)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Ring)
        if Ptr Ring
ptr Ptr Ring -> Ptr Ring -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Ring
forall a. Ptr a
FP.nullPtr
        then Ring -> Maybe Ring
forall a. a -> Maybe a
P.Just (Ring -> Maybe Ring) -> IO Ring -> IO (Maybe Ring)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Ring -> Ring) -> Ptr Ring -> IO Ring
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Ring -> Ring
Ring Ptr Ring
ptr
        else Maybe Ring -> IO (Maybe Ring)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Ring
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `Ring` struct initialized to zero.
newZeroRing :: MonadIO m => m Ring
newZeroRing :: forall (m :: * -> *). MonadIO m => m Ring
newZeroRing = IO Ring -> m Ring
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ring -> m Ring) -> IO Ring -> m Ring
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr Ring)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 IO (Ptr Ring) -> (Ptr Ring -> IO Ring) -> IO Ring
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr Ring -> Ring) -> Ptr Ring -> IO Ring
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Ring -> Ring
Ring

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


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

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

#if defined(ENABLE_OVERLOADING)
data RingDataFieldInfo
instance AttrInfo RingDataFieldInfo where
    type AttrBaseTypeConstraint RingDataFieldInfo = (~) Ring
    type AttrAllowedOps RingDataFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RingDataFieldInfo = (~) Word8
    type AttrTransferTypeConstraint RingDataFieldInfo = (~)Word8
    type AttrTransferType RingDataFieldInfo = Word8
    type AttrGetType RingDataFieldInfo = Word8
    type AttrLabel RingDataFieldInfo = "data"
    type AttrOrigin RingDataFieldInfo = Ring
    attrGet = getRingData
    attrSet = setRingData
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Ring.data"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Ring.html#g:attr:data"
        })

ring_data :: AttrLabelProxy "data"
ring_data = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data RingLenFieldInfo
instance AttrInfo RingLenFieldInfo where
    type AttrBaseTypeConstraint RingLenFieldInfo = (~) Ring
    type AttrAllowedOps RingLenFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RingLenFieldInfo = (~) Word32
    type AttrTransferTypeConstraint RingLenFieldInfo = (~)Word32
    type AttrTransferType RingLenFieldInfo = Word32
    type AttrGetType RingLenFieldInfo = Word32
    type AttrLabel RingLenFieldInfo = "len"
    type AttrOrigin RingLenFieldInfo = Ring
    attrGet = getRingLen
    attrSet = setRingLen
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Ring.len"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Ring.html#g:attr:len"
        })

ring_len :: AttrLabelProxy "len"
ring_len = AttrLabelProxy

#endif


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

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

#if defined(ENABLE_OVERLOADING)
data RingPosFieldInfo
instance AttrInfo RingPosFieldInfo where
    type AttrBaseTypeConstraint RingPosFieldInfo = (~) Ring
    type AttrAllowedOps RingPosFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint RingPosFieldInfo = (~) Word32
    type AttrTransferTypeConstraint RingPosFieldInfo = (~)Word32
    type AttrTransferType RingPosFieldInfo = Word32
    type AttrGetType RingPosFieldInfo = Word32
    type AttrLabel RingPosFieldInfo = "pos"
    type AttrOrigin RingPosFieldInfo = Ring
    attrGet = getRingPos
    attrSet = setRingPos
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Ring.pos"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Ring.html#g:attr:pos"
        })

ring_pos :: AttrLabelProxy "pos"
ring_pos = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Ring
type instance O.AttributeList Ring = RingAttributeList
type RingAttributeList = ('[ '("data", RingDataFieldInfo), '("len", RingLenFieldInfo), '("pos", RingPosFieldInfo)] :: [(Symbol, DK.Type)])
#endif

-- method Ring::sized_new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "element_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The size per element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "reserved_size"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of elements to allocate."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "element_destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Notification called when removing an element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Dazzle" , name = "Ring" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_ring_sized_new" dzl_ring_sized_new :: 
    Word32 ->                               -- element_size : TBasicType TUInt
    Word32 ->                               -- reserved_size : TBasicType TUInt
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- element_destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr Ring)

-- | Creates a new instance of t'GI.Dazzle.Structs.Ring.Ring' with the given number of elements.
ringSizedNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Word32
    -- ^ /@elementSize@/: The size per element.
    -> Word32
    -- ^ /@reservedSize@/: The number of elements to allocate.
    -> GLib.Callbacks.DestroyNotify
    -- ^ /@elementDestroy@/: Notification called when removing an element.
    -> m Ring
    -- ^ __Returns:__ A new t'GI.Dazzle.Structs.Ring.Ring'.
ringSizedNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Word32 -> Word32 -> IO () -> m Ring
ringSizedNew Word32
elementSize Word32
reservedSize IO ()
elementDestroy = IO Ring -> m Ring
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ring -> m Ring) -> IO Ring -> m Ring
forall a b. (a -> b) -> a -> b
$ do
    Ptr (FunPtr C_DestroyNotify)
ptrelementDestroy <- IO (Ptr (FunPtr C_DestroyNotify))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
    FunPtr C_DestroyNotify
elementDestroy' <- C_DestroyNotify -> IO (FunPtr C_DestroyNotify)
GLib.Callbacks.mk_DestroyNotify (Maybe (Ptr (FunPtr C_DestroyNotify))
-> C_DestroyNotify -> C_DestroyNotify
GLib.Callbacks.wrap_DestroyNotify (Ptr (FunPtr C_DestroyNotify)
-> Maybe (Ptr (FunPtr C_DestroyNotify))
forall a. a -> Maybe a
Just Ptr (FunPtr C_DestroyNotify)
ptrelementDestroy) (IO () -> C_DestroyNotify
GLib.Callbacks.drop_closures_DestroyNotify IO ()
elementDestroy))
    Ptr (FunPtr C_DestroyNotify) -> FunPtr C_DestroyNotify -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_DestroyNotify)
ptrelementDestroy FunPtr C_DestroyNotify
elementDestroy'
    Ptr Ring
result <- Word32 -> Word32 -> FunPtr C_DestroyNotify -> IO (Ptr Ring)
dzl_ring_sized_new Word32
elementSize Word32
reservedSize FunPtr C_DestroyNotify
elementDestroy'
    Text -> Ptr Ring -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"ringSizedNew" Ptr Ring
result
    Ring
result' <- ((ManagedPtr Ring -> Ring) -> Ptr Ring -> IO Ring
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Ring -> Ring
Ring) Ptr Ring
result
    Ring -> IO Ring
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ring
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Ring::append_vals
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "ring"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Ring" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlRing." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to the array of values."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "len"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The number of values."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "dzl_ring_append_vals" dzl_ring_append_vals :: 
    Ptr Ring ->                             -- ring : TInterface (Name {namespace = "Dazzle", name = "Ring"})
    Ptr () ->                               -- data : TBasicType TPtr
    Word32 ->                               -- len : TBasicType TUInt
    IO Word32

-- | Appends /@len@/ values located at /@data@/.
ringAppendVals ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ring
    -- ^ /@ring@/: A t'GI.Dazzle.Structs.Ring.Ring'.
    -> Ptr ()
    -- ^ /@data@/: A pointer to the array of values.
    -> Word32
    -- ^ /@len@/: The number of values.
    -> m Word32
    -- ^ __Returns:__ the index of the first item.
ringAppendVals :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ring -> Ptr () -> Word32 -> m Word32
ringAppendVals Ring
ring Ptr ()
data_ Word32
len = IO Word32 -> m Word32
forall a. IO a -> m a
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
$ do
    Ptr Ring
ring' <- Ring -> IO (Ptr Ring)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Ring
ring
    Word32
result <- Ptr Ring -> Ptr () -> Word32 -> IO Word32
dzl_ring_append_vals Ptr Ring
ring' Ptr ()
data_ Word32
len
    Ring -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Ring
ring
    Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data RingAppendValsMethodInfo
instance (signature ~ (Ptr () -> Word32 -> m Word32), MonadIO m) => O.OverloadedMethod RingAppendValsMethodInfo Ring signature where
    overloadedMethod = ringAppendVals

instance O.OverloadedMethodInfo RingAppendValsMethodInfo Ring where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Ring.ringAppendVals",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Ring.html#v:ringAppendVals"
        })


#endif

-- method Ring::foreach
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "ring"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Ring" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlRing." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "func"
--           , argType = TInterface Name { namespace = "GLib" , name = "Func" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GFunc to call for each element."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeCall
--           , argClosure = 2
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data for @func."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_ring_foreach" dzl_ring_foreach :: 
    Ptr Ring ->                             -- ring : TInterface (Name {namespace = "Dazzle", name = "Ring"})
    FunPtr GLib.Callbacks.C_Func ->         -- func : TInterface (Name {namespace = "GLib", name = "Func"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Calls /@func@/ for every item in the t'GI.Dazzle.Structs.Ring.Ring' starting from the most recently
-- inserted element to the least recently inserted.
ringForeach ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ring
    -- ^ /@ring@/: A t'GI.Dazzle.Structs.Ring.Ring'.
    -> GLib.Callbacks.Func
    -- ^ /@func@/: A t'GI.GLib.Callbacks.Func' to call for each element.
    -> m ()
ringForeach :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Ring -> C_DestroyNotify -> m ()
ringForeach Ring
ring C_DestroyNotify
func = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Ring
ring' <- Ring -> IO (Ptr Ring)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Ring
ring
    FunPtr C_Func
func' <- C_Func -> IO (FunPtr C_Func)
GLib.Callbacks.mk_Func (Maybe (Ptr (FunPtr C_Func)) -> C_Func -> C_Func
GLib.Callbacks.wrap_Func Maybe (Ptr (FunPtr C_Func))
forall a. Maybe a
Nothing (C_DestroyNotify -> C_Func
GLib.Callbacks.drop_closures_Func C_DestroyNotify
func))
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Ring -> FunPtr C_Func -> C_DestroyNotify
dzl_ring_foreach Ptr Ring
ring' FunPtr C_Func
func' Ptr ()
forall a. Ptr a
userData
    Ptr Any -> IO ()
forall a. Ptr a -> IO ()
safeFreeFunPtr (Ptr Any -> IO ()) -> Ptr Any -> IO ()
forall a b. (a -> b) -> a -> b
$ FunPtr C_Func -> Ptr Any
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_Func
func'
    Ring -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Ring
ring
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RingForeachMethodInfo
instance (signature ~ (GLib.Callbacks.Func -> m ()), MonadIO m) => O.OverloadedMethod RingForeachMethodInfo Ring signature where
    overloadedMethod = ringForeach

instance O.OverloadedMethodInfo RingForeachMethodInfo Ring where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Ring.ringForeach",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Ring.html#v:ringForeach"
        })


#endif

-- method Ring::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "ring"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Ring" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlRing." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Dazzle" , name = "Ring" })
-- throws : False
-- Skip return : False

foreign import ccall "dzl_ring_ref" dzl_ring_ref :: 
    Ptr Ring ->                             -- ring : TInterface (Name {namespace = "Dazzle", name = "Ring"})
    IO (Ptr Ring)

-- | Atomically increments the reference count of /@ring@/ by one.
ringRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ring
    -- ^ /@ring@/: A t'GI.Dazzle.Structs.Ring.Ring'.
    -> m Ring
    -- ^ __Returns:__ The /@ring@/ pointer.
ringRef :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Ring -> m Ring
ringRef Ring
ring = IO Ring -> m Ring
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Ring -> m Ring) -> IO Ring -> m Ring
forall a b. (a -> b) -> a -> b
$ do
    Ptr Ring
ring' <- Ring -> IO (Ptr Ring)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Ring
ring
    Ptr Ring
result <- Ptr Ring -> IO (Ptr Ring)
dzl_ring_ref Ptr Ring
ring'
    Text -> Ptr Ring -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"ringRef" Ptr Ring
result
    Ring
result' <- ((ManagedPtr Ring -> Ring) -> Ptr Ring -> IO Ring
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Ring -> Ring
Ring) Ptr Ring
result
    Ring -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Ring
ring
    Ring -> IO Ring
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ring
result'

#if defined(ENABLE_OVERLOADING)
data RingRefMethodInfo
instance (signature ~ (m Ring), MonadIO m) => O.OverloadedMethod RingRefMethodInfo Ring signature where
    overloadedMethod = ringRef

instance O.OverloadedMethodInfo RingRefMethodInfo Ring where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Ring.ringRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Ring.html#v:ringRef"
        })


#endif

-- method Ring::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "ring"
--           , argType =
--               TInterface Name { namespace = "Dazzle" , name = "Ring" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #DzlRing." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "dzl_ring_unref" dzl_ring_unref :: 
    Ptr Ring ->                             -- ring : TInterface (Name {namespace = "Dazzle", name = "Ring"})
    IO ()

-- | Atomically decrements the reference count of /@ring@/ by one.  When the
-- reference count reaches zero, the structure is freed.
ringUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Ring
    -- ^ /@ring@/: A t'GI.Dazzle.Structs.Ring.Ring'.
    -> m ()
ringUnref :: forall (m :: * -> *). (HasCallStack, MonadIO m) => Ring -> m ()
ringUnref Ring
ring = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Ring
ring' <- Ring -> IO (Ptr Ring)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Ring
ring
    Ptr Ring -> IO ()
dzl_ring_unref Ptr Ring
ring'
    Ring -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Ring
ring
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RingUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod RingUnrefMethodInfo Ring signature where
    overloadedMethod = ringUnref

instance O.OverloadedMethodInfo RingUnrefMethodInfo Ring where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Dazzle.Structs.Ring.ringUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-dazzle-1.0.2/docs/GI-Dazzle-Structs-Ring.html#v:ringUnref"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveRingMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveRingMethod "appendVals" o = RingAppendValsMethodInfo
    ResolveRingMethod "foreach" o = RingForeachMethodInfo
    ResolveRingMethod "ref" o = RingRefMethodInfo
    ResolveRingMethod "unref" o = RingUnrefMethodInfo
    ResolveRingMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveRingMethod t Ring, O.OverloadedMethod info Ring p) => OL.IsLabel t (Ring -> 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 ~ ResolveRingMethod t Ring, O.OverloadedMethod info Ring p, R.HasField t Ring p) => R.HasField t Ring p where
    getField = O.overloadedMethod @info

#endif

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

#endif